From 699dfca5b018021691b2954b76010edc6101e5e9 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Sun, 21 Apr 2024 15:36:33 +0200
Subject: [PATCH 01/43] wip

---
 _CoqProject              |   2 +
 theories/convex.v        | 128 +++++++++++++++++++--------------------
 theories/preliminaries.v |  33 ++++++++--
 3 files changed, 91 insertions(+), 72 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index 8dcf076..2e74d0f 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -27,3 +27,5 @@ theories/preliminaries_hull.v
 
 -arg -w -arg -notation-overridden
 -arg -w -arg -ambiguous-paths
+theories/smooth_trajectories.v
+theories/generic_trajectories.v
diff --git a/theories/convex.v b/theories/convex.v
index 464edc8..7f9b303 100644
--- a/theories/convex.v
+++ b/theories/convex.v
@@ -1,5 +1,6 @@
-From mathcomp Require Import all_ssreflect all_algebra vector reals ereal classical_sets boolp Rstruct.
-From infotheo Require Import convex Reals_ext.
+From mathcomp Require Import all_ssreflect all_algebra vector reals ereal.
+From mathcomp Require Import classical_sets boolp Rstruct.
+From infotheo Require Import Reals_ext fdist convex.
 Require Import preliminaries.
 
 Import Order.POrderTheory Order.TotalTheory GRing.Theory Num.Theory preliminaries.
@@ -8,8 +9,6 @@ Local Open Scope ring_scope.
 
 Require Import Reals.
 Local Close Scope N_scope.
-Local Close Scope R_scope.
-Delimit Scope R_scope with coqR.
 Delimit Scope nat_scope with N.
 Delimit Scope int_scope with Z.
 Delimit Scope ring_scope with R.
@@ -25,8 +24,7 @@ Local Open Scope classical_set_scope.
 Local Open Scope convex_scope.
 
 Definition convex_set_of (A : set E) : is_convex_set A -> {convex_set E}.
-move=>Aconv.
-by exists A; apply CSet.Mixin.
+by move=> Aconv; exists A; constructor; constructor.
 Defined.
 
 Lemma is_convex_setI (C D : {convex_set E}) : is_convex_set (C `&` D).
@@ -39,76 +37,74 @@ Qed.
 Lemma hullX (F : convType) (C : set E) (D : set F) : hull (C `*` D) = hull C `*` hull D.
 Proof.
 rewrite eqEsubset; split.
-   move=>+ [n][g][d][gCD]-> =>_.
+   move=>+ [n][/=g][/=d][gCD]-> =>_.
    rewrite Convn_pair; split=>/=;
       exists n; [exists (fst \o g) | exists (snd \o g)]; exists d; split=> // + [i] _ <- =>_ /=;
       (suff: ((C `*` D) (g i)) by move=>[]);
       by apply gCD; exists i.
-move=>[+ +][]/=[n][g][d][gC->][m][f][e][fD->]=>_ _.
+move=>[+ +][]/=[n][g][d][gC->][m][f][e] [fD->]=>_ _.
 exists (n * m)%N, (fun i=> let (i, j) := split_prod i in (g i, f j)), (fdistmap (unsplit_prod (n:=m)) (d `x e)%fdist); split.
    move=>+ [i] _ <- =>_.
    by case: (split_prod i)=>a b; split; [apply gC | apply fD].
 rewrite Convn_pair/comp/=; congr pair; apply S1_inj; rewrite !S1_Convn big_prod_ord/=.
   apply eq_big => // i _.
-  rewrite -(scale1pt (scalept _ _)) scaleptA// -(FDist.f1 e).
-  move: (@mulr_suml R_ringType _ (index_enum [finType of 'I_m]) (mem 'I_m)
-    (fun i => nneg_ff e i) (nneg_ff d i)); rewrite -RmultE => ->.
-  simple refine (let h : nneg_fun 'I_m := _ in _).
-     exists (fun j => nneg_ff e j * nneg_ff d i)%coqR=>j.
-     exact: ssrR.mulR_ge0.
-  have -> : (\sum_(j in 'I_m) (nneg_ff e j) * (nneg_ff d i) =
-             \sum_(i in 'I_m) nneg_f h i)%coqR.
-     by apply eq_big => // j _; rewrite fdist_prodE.
+  rewrite -(scale1pt (scalept _ _)) scaleptA // -[(1 * d i)%coqR]/(1 * d i) -(FDist.f1 e).
+  rewrite mulr_suml.
+  have @h : nneg_fun 'I_m.
+    (* BUG HB.pack *)
+    exists (fun j => e j * d i)%coqR => j.
+    by apply: ssrR.mulR_ge0.
+  under eq_bigr => j _ do rewrite -[e j * d i]/(h j).
   rewrite scalept_sum; apply eq_big=>// j _.
   rewrite /h /= fdistmapE.
   have -> : (\sum_(a in [finType of 'I_n * 'I_m] |
                    a \in preim (@unsplit_prod _ m) (pred1 (Ordinal (unsplit_prodp i j))))
-             nneg_ff (fdist_prod d (fun=> e)) a =
+              (fdist_prod d (fun=> e)) a =
              \sum_(a in [finType of 'I_n * 'I_m] | a \in pred1 (i, j))
-             nneg_ff (fdist_prod d (fun=> e)) a)%coqR.
+              (fdist_prod d (fun=> e)) a)%coqR.
      apply eq_big=>// k; congr andb; rewrite 3!inE.
      by apply: (eqtype.inj_eq _ k (i, j)); exact: (can_inj (@unsplit_prodK _ _)).
   rewrite (big_pred1 (i, j))// fdist_prodE/= ssrR.mulRC; congr (scalept _ (S1 (g _))).
   by move: (unsplit_prodK (i, j)) => /(congr1 fst)/esym.
 rewrite (exchange_big_dep xpredT)//=; apply: eq_bigr => j _.
-rewrite -(scale1pt (scalept _ _)) scaleptA// -(FDist.f1 d).
-move: (@mulr_suml R_ringType _ (index_enum [finType of 'I_n]) (mem 'I_n)
-  (fun i=> nneg_ff d i) (nneg_ff e j)); rewrite -RmultE => ->.
-simple refine (let h : nneg_fun 'I_n := _ in _).
-   exists (fun i=> nneg_ff d i * nneg_ff e j)%coqR => i.
-   exact: ssrR.mulR_ge0.
-have -> : (\sum_(i in 'I_n) nneg_ff d i * nneg_ff e j = \sum_(i in 'I_n) nneg_f h i)%coqR.
-   by apply eq_big=>// i _; rewrite fdist_prodE.
+rewrite -(scale1pt (scalept _ _)) scaleptA// -[(1 * e j)%coqR]/(1 * e j) -(FDist.f1 d).
+rewrite mulr_suml.
+
+have @h : nneg_fun 'I_n.
+(* BUG HB.pack *)
+   exists (fun i => d i * e j)%coqR => i.
+   by apply: ssrR.mulR_ge0.
+under eq_bigr => i _ do rewrite -[d i * e j]/(h i).    
 rewrite scalept_sum; apply: eq_big => // i _.
 rewrite /h/= fdistmapE.
 have -> : (\sum_(a in [finType of 'I_n * 'I_m] |
    a \in preim (unsplit_prod (n:=m)) (pred1 (Ordinal (unsplit_prodp i j))))
-         nneg_ff (fdist_prod d (fun=> e)) a =
+          (fdist_prod d (fun=> e)) a =
    \sum_(a in
    [finType of 'I_n * 'I_m] | a \in pred1 (i, j))
-      nneg_ff (FDist.f (fdist_prod d (fun=> e))) a)%coqR.
+       (FDist.f (fdist_prod d (fun=> e))) a)%coqR.
    apply: eq_big=>// k; congr andb; rewrite 3!inE.
    by apply: (eqtype.inj_eq _ k (i, j)); exact (can_inj (@unsplit_prodK _ _)).
-rewrite (big_pred1 (i, j))// fdist_prodE/= ssrR.mulRC; congr (scalept _ (S1 (f _))).
+rewrite (big_pred1 (i, j))// fdist_prodE/=; congr (scalept _ (S1 (f _))).
 by move:(unsplit_prodK (i, j))=>/(congr1 snd)/esym.
 Qed.
 
 End convex.
-
-Lemma add_affine (E : lmodType R_ringType) : affine (fun p : E * E => p.1 + p.2).
+Import LmoduleConvex.
+Lemma add_affine (E : lmodType R) : affine (fun p : E * E => p.1 + p.2).
 Proof.
 move=>p/= [x0 x1] [y0 y1]/=.
 by rewrite/conv/= addrACA -2!scalerDr.
 Qed.
 
-Lemma scale_affine (E : lmodType R_ringType) (t : R) : affine (fun x : E => t *: x).
+Lemma scale_affine (E : lmodType R) (t : R) : affine (fun x : E => t *: x).
 Proof.
 move=> p/= x y.
 by rewrite/conv/= scalerDr; congr GRing.add; rewrite 2!scalerA mulrC.
 Qed.
 
 Section C.
-Variable E F: lmodType R_ringType.
+Variable E F: lmodType R.
 Variable f : {linear E -> F}.
 
 Local Open Scope fun_scope.
@@ -152,13 +148,13 @@ Qed.
 End face.
 Section face.
 
-Variable E: lmodType R_ringType.
+Variable E: lmodType R.
 
 Local Open Scope fun_scope.
 Local Open Scope ring_scope.
 Local Open Scope convex_scope.
 
-Lemma probinvn1 : probinvn 1 = 2^-1 :> R_numFieldType.
+Lemma probinvn1 : probinvn 1 = (2^-1)%R. R_numFieldType.
 Proof.
 rewrite /R_numFieldType /GRing.inv /= /Rinvx.
 case:ifP=>// /negbFE.
@@ -167,7 +163,7 @@ Qed.
 
 Lemma onem_half: onem 2^-1 = 2^-1.
 Proof.
-have ne20: (2 : R_ringType) != 0 by rewrite intr_eq0.
+have ne20: (2 : R) != 0 by rewrite intr_eq0.
 apply (mulfI ne20).
 by rewrite mulrBr mulr1 divff// -pmulrn mulr2n -addrA subrr addr0.
 Qed.
@@ -178,8 +174,8 @@ Lemma ext_carac (A : {convex_set E}) (x: E): x \in A -> [<-> x \in ext A;
   face A [set x]].
 Proof.
 move=>xA.
-have ne20: (2 : R_ringType) != 0 by rewrite intr_eq0.
-have ge20: (0 : R_ringType) <= 2 by apply mulrz_ge0=>//; exact ler01.
+have ne20: (2 : R) != 0 by rewrite intr_eq0.
+have ge20: (0 : R) <= 2 by apply mulrz_ge0=>//; exact ler01.
 split.
    move=>xext u v uA vA xe.
    move: xext=>/set_mem /(_ u v uA vA).
@@ -202,16 +198,16 @@ split.
    move=>xext.
    apply/asboolP=>u v t [uA ux] [vA vx].
    split; first by move:(convex_setP A)=>/asboolP; apply.
-   wlog: u v t xext xA uA ux vA vx / (t : R_ringType) <= 2^-1.
+   wlog: u v t xext xA uA ux vA vx / (t : R) <= 2^-1.
       move=>h.
-      have [tle|tle] := leP (t : R_ringType) (2^-1); first exact: (h u v t).
+      have [tle|tle] := leP (t : R) (2^-1); first exact: (h u v t).
       rewrite convC.
       apply (h v u (onem t)%:pr)=>//.
       rewrite -onem_half; apply ler_sub=>//.
       exact/ltW.
    move=>tle.
-   have t01: ssrR.leRb (Rdefinitions.IZR BinNums.Z0) (2%:R*(t : R_ringType)) &&
-  ssrR.leRb (2*(t : R_ringType)) (Rdefinitions.IZR (BinNums.Zpos 1%AC)).
+   have t01: ssrR.leRb (Rdefinitions.IZR BinNums.Z0) (2%:R*(t : R)) &&
+  ssrR.leRb (2*(t : R)) (Rdefinitions.IZR (BinNums.Zpos 1%AC)).
       apply/andP; split; apply/ssrR.leRP/RleP.
          apply mulr_ge0=>//.
          by apply/RleP/prob_ge0.
@@ -222,7 +218,7 @@ split.
    have ->: p_of_rs (Prob.mk t01) (probinvn 1) = t.
       apply val_inj.
       rewrite/= p_of_rsE/=.
-      have tE: (2*(t : R_ringType))/2 = t.
+      have tE: (2*(t : R))/2 = t.
          by rewrite mulrAC divff// mul1r.
       rewrite -{2}tE.
       congr Rdefinitions.RbaseSymbolsImpl.Rmult.
@@ -268,7 +264,7 @@ split => //.
   by apply (Gface x).
 Qed.
 
-Definition supporting_hyperplane (A : set E) (f: {linear E -> R^o}) (a: R_ringType) :=
+Definition supporting_hyperplane (A : set E) (f: {linear E -> R^o}) (a: R) :=
   (exists x, x \in A /\ f x = a) /\
   ((forall x, x \in A -> f x <= a) \/ (forall x, x \in A -> a <= f x)).
 
@@ -280,7 +276,7 @@ by rewrite affine_conv -in_setE; apply/mem_convex_set; rewrite in_setE.
 Qed.
 
 (* TOTHINK : lemmas prove is_convex_set but use {convex_set _}. *)
-Lemma supporting_hyperplan_face (A : {convex_set E}) (f: {linear E -> R^o}) (a: R_ringType) :
+Lemma supporting_hyperplan_face (A : {convex_set E}) (f: {linear E -> R^o}) (a: R) :
   supporting_hyperplane A f a <->
   (exists x, x \in A /\ f x = a) /\ face A (A `&` (f @^-1` [set a])).
 Proof.
@@ -296,12 +292,12 @@ split; move=>[hex hface]; split=>//.
       move=>/(_ hex' (or_introl hf') hf'); congr (face A (A `&` _)).
       by rewrite eqEsubset; split=>x /= /eqP; rewrite -scaleN1r linearZZ scaleN1r; [ rewrite eqr_opp | rewrite -eqr_opp ]=>/eqP.
    move=> hf; apply face'P; split; [ by apply subIsetl | |].
-      exact: (is_convex_setI _ (convex_set_of (is_convex_set_preimage _ (convex_set_of (is_convex_set1 (a : GRing.regular_lmodType R_ringType)))))).
+      exact: (is_convex_setI _ (convex_set_of (is_convex_set_preimage _ (convex_set_of (is_convex_set1 (a : GRing.regular_lmodType R)))))).
    move=> x u v /set_mem [xA xa] uA vA /set_mem [t _ tx] xv; apply mem_set; (split; [ by apply set_mem |]); apply /eqP; rewrite -lte_anti; apply /andP; (split; [ by apply hf |]).
-   have t0 : (t : R_ringType) != 0.
+   have t0 : (t : R) != 0.
       by apply/eqP=>/val_inj t0; subst t; move: tx xv; rewrite conv0 => ->; rewrite eqxx.
-   have tgt : 0 < (t : R_ringType) by rewrite lt0r t0=>/=; exact/RleP.
-   move: tx=>/(f_equal (fun x=> (t : R_ringType)^-1 *: (x - (onem t) *: v))).
+   have tgt : 0 < (t : R) by rewrite lt0r t0=>/=; exact/RleP.
+   move: tx=>/(f_equal (fun x=> (t : R)^-1 *: (x - (onem t) *: v))).
    rewrite -addrA subrr addr0 scalerA mulVf // scale1r=>->.
    rewrite linearZZ linearD xa -scaleNr linearZZ ler_pdivl_mull// addrC -subr_ge0 -addrA -mulNr -{1}[a]mul1r -mulrDl scaleNr -scalerN -mulrDr; apply mulr_ge0.
       exact/RleP.
@@ -351,22 +347,22 @@ Qed.
 End face.
 Section cone.
 
-Variable E: lmodType R_ringType.
+Variable E: lmodType R.
 
 Local Open Scope fun_scope.
 Local Open Scope ring_scope.
 Local Open Scope convex_scope.
 
 Definition cone0 (A : set E) :=
-  ([set (t : R_ringType) *: a | t in (@setT Rpos) & a in A] `<=` A)%classic.
+  ([set (t : R) *: a | t in (@setT Rpos) & a in A] `<=` A)%classic.
 
 Definition cone (x: E) (A: set E) := cone0 [set a - x | a in A]%classic.
 
 Lemma cone0_convex (A: set E): cone0 A ->
   (is_convex_set A <-> ([set a+b | a in A & b in A] `<=` A)%classic).
 Proof.
-have ne20: (2 : R_ringType) != 0 by rewrite intr_eq0.
-have /RltP/ssrR.ltRP gt20: (0 : R_ringType) < 2 by rewrite ltr0z.
+have ne20: (2 : R) != 0 by rewrite intr_eq0.
+have /RltP/ssrR.ltRP gt20: (0 : R) < 2 by rewrite ltr0z.
 move=>Acone; split=>Aconv.
    move=>x [u uA] [v vA] <-.
    have uA2: A (2 *: u) by apply Acone; exists (Rpos.mk gt20)=>//; exists u.
@@ -379,7 +375,7 @@ move:(prob_ge0 t)=>/RleP; rewrite le0r=>/orP; case.
    by rewrite/conv/= =>/eqP ->; rewrite scale0r add0r onem0 scale1r.
 move=>/RltP/ssrR.ltRP t0; move: (prob_le1 t)=>/RleP; rewrite -subr_ge0 le0r=>/orP; case.
    by rewrite subr_eq0 /conv/= =>/eqP <-; rewrite onem1 scale0r addr0 scale1r.
-move=>/RltP/ssrR.ltRP t1; apply Aconv; exists ((t : R_ringType) *: x);
+move=>/RltP/ssrR.ltRP t1; apply Aconv; exists ((t : R) *: x);
    [| exists ((onem t) *: y) ]=>//; apply Acone.
   by exists (Rpos.mk t0)=>//; exists x.
 by exists (Rpos.mk t1)=>//; exists y.
@@ -389,7 +385,7 @@ Qed.
 (* TODO: maybe change the 0 <= k i to 0 < k i in the definition of conv. *)
 
 Definition cone0_of (A: set E): set E := [set a | exists n (s : 'I_n.+1 -> E) (k: 'I_n.+1 -> Rpos),
-  \sum_i (k i : R_ringType) *: (s i) = a /\ (range s `<=` A)%classic].
+  \sum_i (k i : R) *: (s i) = a /\ (range s `<=` A)%classic].
 
 Lemma cone0_of_cone0 (A: set E): cone0 (cone0_of A).
 Proof.
@@ -398,11 +394,11 @@ rewrite scaler_sumr; exists n, s, (fun i => mulRpos t (k i)); split => //.
 by apply congr_big=>// i _; apply /esym; apply scalerA.
 Qed.
 
-Lemma cone0_of_hullE (A: set E): cone0_of A = [set (t : R_ringType) *: a | t in (@setT Rpos) & a in (hull A)]%classic.
+Lemma cone0_of_hullE (A: set E): cone0_of A = [set (t : R) *: a | t in (@setT Rpos) & a in (hull A)]%classic.
 Proof.
 rewrite eqEsubset; split=>x.
-   move=>[n [s [k [<- kA]]]]; set t := \sum_i (k i : R_ringType).
-   have k0' (i : 'I_n.+1) : true -> 0 <= (k i : R_ringType) by move=> _; apply/ltW/RltP/Rpos_gt0.
+   move=>[n [s [k [<- kA]]]]; set t := \sum_i (k i : R).
+   have k0' (i : 'I_n.+1) : true -> 0 <= (k i : R) by move=> _; apply/ltW/RltP/Rpos_gt0.
    have: 0 <= t by apply sumr_ge0.
    rewrite le0r=>/orP; case.
       move=>/eqP /psumr_eq0P; move=> /(_ k0') /(_ ord0 Logic.eq_refl) k00; exfalso.
@@ -415,7 +411,7 @@ rewrite eqEsubset; split=>x.
          by apply congr_big=>// i _; rewrite ffunE.
       rewrite -mulr_sumr mulrC divff//.
       by move:t0; rewrite lt0r=>/andP[].
-   move:(t0)=>/RltP/ssrR.ltRP t0'; exists (Rpos.mk t0')=>//; exists (t^-1 *: \sum_i (k i : R_ringType) *: s i).
+   move:(t0)=>/RltP/ssrR.ltRP t0'; exists (Rpos.mk t0')=>//; exists (t^-1 *: \sum_i (k i : R) *: s i).
       exists n.+1, s, (@FDist.make _ (finfun (fun i=> t^-1 * k i)) tk0 tk1); split=> //.
       rewrite scaler_sumr avgnrE.
       apply congr_big=>// i _.
@@ -423,19 +419,19 @@ rewrite eqEsubset; split=>x.
    by rewrite scalerA divff ?gt_eqF// scale1r.
 move=>[t /= _] [a [n [s [d [sA ->]]]]] <-.
 rewrite avgnrE scaler_sumr (@mathcomp_extra.bigID_idem _ _ _ _ _ _ _ _ (fun i=> 0 < d i)); [| apply addrA | apply addrC | apply addr0 ].
-have ->: \sum_(i | true && ~~ (0 < d i)) (t : R_ringType) *: (d i *: s i) = \sum_(i | true && ~~ (0 < d i)) 0 *: 0.
+have ->: \sum_(i | true && ~~ (0 < d i)) (t : R) *: (d i *: s i) = \sum_(i | true && ~~ (0 < d i)) 0 *: 0.
    apply congr_big=>// i /andP [_]; rewrite lt0r negb_and negbK.
    move:(FDist.ge0 d i)=>/RleP->; rewrite orbF=>/eqP->.
    by rewrite 2!scale0r GRing.scaler0.
 rewrite -[\sum_(_ < _ | _) 0 *: 0]scaler_sumr scale0r addr0 -big_filter /=.
 remember [seq i <- index_enum [finType of 'I_n] | 0 < d i] as I; move: HeqI=>/esym HeqI.
 case: I HeqI=> [| i I] HeqI.
-   exfalso; move: (FDist.f1 d) (oner_neq0 R_ringType); rewrite (@mathcomp_extra.bigID_idem _ _ _ _ _ _ _ _ (fun i=> 0 < d i)); [| apply addrA | apply addrC | apply addr0 ].
+   exfalso; move: (FDist.f1 d) (oner_neq0 R); rewrite (@mathcomp_extra.bigID_idem _ _ _ _ _ _ _ _ (fun i=> 0 < d i)); [| apply addrA | apply addrC | apply addr0 ].
    rewrite -big_filter HeqI big_nil/=.
    have ->: forall x, Rdefinitions.RbaseSymbolsImpl.Rplus Rdefinitions.RbaseSymbolsImpl.R0 x = 0+x by [].
    have ->: Rdefinitions.IZR (BinNums.Zpos 1%AC) = 1 by [].
    rewrite add0r=><- /eqP; apply.
-   transitivity (\sum_(i < n | true && ~~ (0 < d i)) (0*0:R_ringType)).
+   transitivity (\sum_(i < n | true && ~~ (0 < d i)) (0*0:R)).
       2: by rewrite -mulr_sumr mul0r.
    by apply congr_big=>// i /= dile; move: (FDist.ge0 d i)=>/RleP; rewrite le0r mul0r=>/orP; case=> [ /eqP // | ]; move: dile=>/[swap]->.
 have: subseq (i::I) (index_enum [finType of 'I_n]) by rewrite -HeqI; apply filter_subseq.
@@ -476,7 +472,7 @@ End cone.
 Section Fun.
 
 Variable E: convType.
-Variable f: E -> \bar R_ringType.
+Variable f: E -> \bar R.
 
 Local Open Scope fun_scope.
 Local Open Scope ring_scope.
@@ -484,10 +480,10 @@ Local Open Scope ereal_scope.
 Local Open Scope convex_scope.
 
 Definition fconvex := forall (x y: E) (t: prob),
-  f (x <|t|> y) <= EFin (t : R_ringType) * f x + EFin (onem t)%R * f y.
+  f (x <|t|> y) <= EFin (t : R) * f x + EFin (onem t)%R * f y.
 
 Definition fconvex_strict := forall (x y: E) (t: oprob), x <> y ->
-  f (x <|t|> y) < EFin (t : R_ringType) * f x + EFin (onem t)%R * f y.
+  f (x <|t|> y) < EFin (t : R) * f x + EFin (onem t)%R * f y.
 
 Lemma fconvex_max_ext (C: {convex_set E}) (x: E):
   fconvex_strict ->
diff --git a/theories/preliminaries.v b/theories/preliminaries.v
index 60404a8..718d00d 100644
--- a/theories/preliminaries.v
+++ b/theories/preliminaries.v
@@ -1,4 +1,23 @@
+From elpi Require Import elpi.
+
+#[projections(primitive)] Record r := { fst : nat -> nat; snd : bool }.
+Axiom t : r.
+Elpi Command test.
+Elpi Query lp:{{
+  coq.say "quotation for primitive fst t" {{ t.(fst) 3 }},
+  coq.say "quotation for compat fst t" {{ fst t 3 }},
+  coq.locate "r" (indt I),
+  coq.env.projections I [some P1,some P2],
+  coq.say "compatibility constants" P1 P2,
+  coq.env.primitive-projections I [some (pr Q1 N1), some (pr Q2 N2)],
+  coq.say "fst primproj" Q1 N1,
+  coq.say "snd primproj" Q2 N2
+}}.
+
+
+
 Require Import Reals.
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect all_algebra vector reals classical_sets Rstruct.
 From infotheo Require Import convex.
 
@@ -14,7 +33,7 @@ Unset Printing Implicit Defensive.
 Lemma enum_rank_index {T : finType} i :
   nat_of_ord (enum_rank i) = index i (enum T).
 Proof.
-rewrite /enum_rank /enum_rank_in /insubd /odflt /oapp insubT//.
+rewrite /enum_rank [enum_rank_in]unlock /insubd /odflt /oapp insubT//.
 by rewrite cardE index_mem mem_enum.
 Qed.
 
@@ -22,7 +41,9 @@ Qed.
    deep into the library ? *)
 Lemma enum_prodE {T1 T2 : finType} :
   enum [finType of T1 * T2] = prod_enum T1 T2.
-Proof. by rewrite enumT Finite.EnumDef.enumDef. Qed.
+Proof.
+by rewrite /enum_mem unlock /= /prod_enum -(@eq_filter _ predT) ?filter_predT.
+Qed.
 
 Lemma index_allpairs {T1 T2: eqType} (s1: seq T1) (s2: seq T2) x1 x2 :
     x1 \in s1 -> x2 \in s2 ->
@@ -30,7 +51,7 @@ Lemma index_allpairs {T1 T2: eqType} (s1: seq T1) (s2: seq T2) x1 x2 :
     ((index x1 s1) * (size s2) + index x2 s2)%N.
 Proof.
 move=>ins1 ins2.
-elim: s1 ins1=>//= a s1 IHs1 ins1.
+elim: s1 ins1=>//= a s1 IHs1 ins1. (* HERE*)
 rewrite index_cat.
 case ax: (a == x1).
    move: ax=>/eqP ax; subst a; rewrite /muln /muln_rec /addn /addn_rec /=.
@@ -43,11 +64,11 @@ case in12: ((x1, x2) \in [seq (a, x0) | x0 <- s2]).
 by rewrite size_map (IHs1 ins1) addnA.
 Qed.
 
-Lemma enum_rank_prod {T T': finType} i j :
-  (nat_of_ord (@enum_rank [finType of T * T'] (i, j)) = (enum_rank i) * #|T'| + enum_rank j)%N.
+Lemma enum_rank_prod {T T': finType} (i : T) (j : T') :
+  (nat_of_ord (enum_rank (i, j)) = (enum_rank i) * #|T'| + enum_rank j)%N.
 Proof.
 do 3 rewrite enum_rank_index.
-rewrite enumT Finite.EnumDef.enumDef cardE=>/=.
+rewrite enum_prodE cardE /=.
 by apply index_allpairs; rewrite enumT.
 Qed.
 

From 75d3d5c5dbd6fe21faa04569242be495ecc8270f Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Mon, 22 Apr 2024 15:09:27 +0900
Subject: [PATCH 02/43] upd meta.yml

---
 .github/workflows/docker-action.yml | 12 +++-----
 README.md                           | 20 ++++++-------
 coq-mathcomp-trajectories.opam      | 20 ++++++-------
 meta.yml                            | 46 +++++++++++++++--------------
 4 files changed, 48 insertions(+), 50 deletions(-)

diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml
index 69e39c5..41f0932 100644
--- a/.github/workflows/docker-action.yml
+++ b/.github/workflows/docker-action.yml
@@ -6,13 +6,9 @@ on:
   push:
     branches:
       - master
-    paths-ignore:
-      - 'documents/**'
   pull_request:
     branches:
       - '**'
-    paths-ignore:
-      - 'documents/**'
 
 jobs:
   build:
@@ -21,17 +17,17 @@ jobs:
     strategy:
       matrix:
         image:
-          - 'mathcomp/mathcomp:1.16.0-coq-8.15'
-          - 'mathcomp/mathcomp:1.16.0-coq-8.16'
+          - 'mathcomp/mathcomp:2.2.0-coq-8.17'
+          - 'mathcomp/mathcomp:2.2.0-coq-8.18'
+          - 'mathcomp/mathcomp:2.2.0-coq-8.19'
       fail-fast: false
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v2
       - uses: coq-community/docker-coq-action@v1
         with:
           opam_file: 'coq-mathcomp-trajectories.opam'
           custom_image: ${{ matrix.image }}
 
-
 # See also:
 # https://github.com/coq-community/docker-coq-action#readme
 # https://github.com/erikmd/docker-coq-github-action-demo
diff --git a/README.md b/README.md
index 2e27acb..b3c41bb 100644
--- a/README.md
+++ b/README.md
@@ -20,17 +20,17 @@ TODO
   - Reynald Affeldt (initial)
   - Yves Bertot (initial)
 - License: [CeCILL-C](LICENSE)
-- Compatible Coq versions: Coq >= 8.15, MathComp >= 1.16
+- Compatible Coq versions: Coq >= 8.17, MathComp >= 2.2.0
 - Additional dependencies:
-  - [MathComp ssreflect 1.15 or later](https://math-comp.github.io)
-  - [MathComp fingroup 1.15 or later](https://math-comp.github.io)
-  - [MathComp algebra 1.15 or later](https://math-comp.github.io)
-  - [MathComp solvable 1.15 or later](https://math-comp.github.io)
-  - [MathComp field 1.16 or later](https://math-comp.github.io)
-  - [Mathcomp real closed 1.1.3 or later](https://github.com/math-comp/real-closed/)
-  - [Algebra tactics 1.0.0](https://github.com/math-comp/algebra-tactics)
-  - [MathComp analysis](https://github.com/math-comp/analysis)
-  - [Infotheo](https://github.com/affeldt-aist/infotheo)
+  - [MathComp ssreflect 2.2.0 or later](https://math-comp.github.io)
+  - [MathComp fingroup 2.2.0 or later](https://math-comp.github.io)
+  - [MathComp algebra 2.2.0 or later](https://math-comp.github.io)
+  - [MathComp solvable 2.2.0 or later](https://math-comp.github.io)
+  - [MathComp field 2.2.0 or later](https://math-comp.github.io)
+  - [Mathcomp real closed 2.0.0 or later](https://github.com/math-comp/real-closed/)
+  - [Algebra tactics 1.2.0 or later](https://github.com/math-comp/algebra-tactics)
+  - [MathComp analysis 1.0.0 or later](https://github.com/math-comp/analysis)
+  - [Infotheo 0.7.0 of later](https://github.com/affeldt-aist/infotheo)
 - Coq namespace: `mathcomp.trajectories`
 - Related publication(s):
   - [TODO](TODO) doi:[TODO](https://doi.org/TODO)
diff --git a/coq-mathcomp-trajectories.opam b/coq-mathcomp-trajectories.opam
index 6badeca..db76215 100644
--- a/coq-mathcomp-trajectories.opam
+++ b/coq-mathcomp-trajectories.opam
@@ -17,16 +17,16 @@ TODO"""
 build: [make "-j%{jobs}%"]
 install: [make "install"]
 depends: [
-  "coq" { (>= "8.14" & < "8.17~") | (= "dev") }
-  "coq-mathcomp-ssreflect" { (>= "1.16.0" & < "1.17~") | (= "dev") }
-  "coq-mathcomp-fingroup" { (>= "1.16.0" & < "1.17~") | (= "dev") }
-  "coq-mathcomp-algebra" { (>= "1.16.0" & < "1.17~") | (= "dev") }
-  "coq-mathcomp-solvable" { (>= "1.16.0" & < "1.17~") | (= "dev") }
-  "coq-mathcomp-field" { (>= "1.16.0" & < "1.17~") | (= "dev") }
-  "coq-mathcomp-real-closed" { (>= "1.1.3") | (= "dev") }
-  "coq-mathcomp-algebra-tactics" { (>= "1.0.0") | (= "dev") }
-  "coq-mathcomp-analysis" { (>= "0.6.1") & (< "0.7~")}
-  "coq-infotheo" { >= "0.5.1" & < "0.6~"}
+  "coq" { (>= "8.17" & < "8.20~") | (= "dev") }
+  "coq-mathcomp-ssreflect" { (>= "2.2.0") | (= "dev") }
+  "coq-mathcomp-fingroup" { (>= "2.2.0") | (= "dev") }
+  "coq-mathcomp-algebra" { (>= "2.2.0") | (= "dev") }
+  "coq-mathcomp-solvable" { (>= "2.2.0") | (= "dev") }
+  "coq-mathcomp-field" { (>= "2.2.0") | (= "dev") }
+  "coq-mathcomp-real-closed" { (>= "2.0.0") | (= "dev") }
+  "coq-mathcomp-algebra-tactics" { (>= "1.2.0") | (= "dev") }
+  "coq-mathcomp-analysis" { (>= "1.0.0") }
+  "coq-infotheo" { >= "0.7.0"}
 ]
 
 tags: [
diff --git a/meta.yml b/meta.yml
index 0ae1a2f..7057cff 100644
--- a/meta.yml
+++ b/meta.yml
@@ -27,61 +27,63 @@ license:
   file: LICENSE
 
 supported_coq_versions:
-  text: Coq >= 8.15, MathComp >= 1.16
-  opam: '{ (>= "8.14" & < "8.17~") | (= "dev") }'
+  text: Coq >= 8.17, MathComp >= 2.2.0
+  opam: '{ (>= "8.17" & < "8.20~") | (= "dev") }'
 
 tested_coq_opam_versions:
-- version: '1.16.0-coq-8.15'
+- version: '2.2.0-coq-8.17'
   repo: 'mathcomp/mathcomp'
-- version: '1.16.0-coq-8.16'
+- version: '2.2.0-coq-8.18'
+  repo: 'mathcomp/mathcomp'
+- version: '2.2.0-coq-8.19'
   repo: 'mathcomp/mathcomp'
 
 dependencies:
 - opam:
     name: coq-mathcomp-ssreflect
-    version: '{ (>= "1.16.0" & < "1.17~") | (= "dev") }'
+    version: '{ (>= "2.2.0") | (= "dev") }'
   description: |-
-    [MathComp ssreflect 1.15 or later](https://math-comp.github.io)
+    [MathComp ssreflect 2.2.0 or later](https://math-comp.github.io)
 - opam:
     name: coq-mathcomp-fingroup
-    version: '{ (>= "1.16.0" & < "1.17~") | (= "dev") }'
+    version: '{ (>= "2.2.0") | (= "dev") }'
   description: |-
-    [MathComp fingroup 1.15 or later](https://math-comp.github.io)
+    [MathComp fingroup 2.2.0 or later](https://math-comp.github.io)
 - opam:
     name: coq-mathcomp-algebra
-    version: '{ (>= "1.16.0" & < "1.17~") | (= "dev") }'
+    version: '{ (>= "2.2.0") | (= "dev") }'
   description: |-
-    [MathComp algebra 1.15 or later](https://math-comp.github.io)
+    [MathComp algebra 2.2.0 or later](https://math-comp.github.io)
 - opam:
     name: coq-mathcomp-solvable
-    version: '{ (>= "1.16.0" & < "1.17~") | (= "dev") }'
+    version: '{ (>= "2.2.0") | (= "dev") }'
   description: |-
-    [MathComp solvable 1.15 or later](https://math-comp.github.io)
+    [MathComp solvable 2.2.0 or later](https://math-comp.github.io)
 - opam:
     name: coq-mathcomp-field
-    version: '{ (>= "1.16.0" & < "1.17~") | (= "dev") }'
+    version: '{ (>= "2.2.0") | (= "dev") }'
   description: |-
-    [MathComp field 1.16 or later](https://math-comp.github.io)
+    [MathComp field 2.2.0 or later](https://math-comp.github.io)
 - opam:
     name: coq-mathcomp-real-closed
-    version: '{ (>= "1.1.3") | (= "dev") }'
+    version: '{ (>= "2.0.0") | (= "dev") }'
   description: |-
-    [Mathcomp real closed 1.1.3 or later](https://github.com/math-comp/real-closed/)
+    [Mathcomp real closed 2.0.0 or later](https://github.com/math-comp/real-closed/)
 - opam:
     name: coq-mathcomp-algebra-tactics
-    version: '{ (>= "1.0.0") | (= "dev") }'
+    version: '{ (>= "1.2.0") | (= "dev") }'
   description: |-
-    [Algebra tactics 1.0.0](https://github.com/math-comp/algebra-tactics)
+    [Algebra tactics 1.2.0 or later](https://github.com/math-comp/algebra-tactics)
 - opam:
     name: coq-mathcomp-analysis
-    version: '{ (>= "0.6.1") & (< "0.7~")}'
+    version: '{ (>= "1.0.0") }'
   description: |-
-    [MathComp analysis](https://github.com/math-comp/analysis)
+    [MathComp analysis 1.0.0 or later](https://github.com/math-comp/analysis)
 - opam:
     name: coq-infotheo
-    version: '{ >= "0.5.1" & < "0.6~"}'
+    version: '{ >= "0.7.0"}'
   description: |-
-    [Infotheo](https://github.com/affeldt-aist/infotheo)
+    [Infotheo 0.7.0 of later](https://github.com/affeldt-aist/infotheo)
 
 namespace: mathcomp.trajectories
 

From c3a6d9f24ef0bdb23f8f94c185b6fdb420dcbd4d Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Mon, 22 Apr 2024 16:54:42 +0900
Subject: [PATCH 03/43] progress (broken)

---
 _CoqProject                  |   1 +
 html/Add.html                |  30 ---
 html/Add.ml                  | 403 -------------------------------
 html/AddScript.js            |   4 -
 html/Makefile.coq.local      |  62 -----
 html/add.v                   |  14 --
 html/curve.html              |  27 ---
 html/grid.html               |  46 ----
 html/grid.js                 | 446 -----------------------------------
 html/jAdd.ml                 |  57 -----
 html/jAdd.mli                |   6 -
 html/jSmoothTrajectories.ml  | 137 -----------
 html/jSmoothTrajectories.mli |   6 -
 html/script.js               | 171 --------------
 theories/convex.v            | 176 ++++++++------
 theories/desc.v              |   2 +-
 theories/desc1.v             |   6 +-
 theories/pol.v               |  15 +-
 theories/preliminaries.v     |   2 +-
 19 files changed, 118 insertions(+), 1493 deletions(-)
 delete mode 100755 html/Add.html
 delete mode 100644 html/Add.ml
 delete mode 100644 html/AddScript.js
 delete mode 100644 html/Makefile.coq.local
 delete mode 100644 html/add.v
 delete mode 100755 html/curve.html
 delete mode 100755 html/grid.html
 delete mode 100644 html/grid.js
 delete mode 100644 html/jAdd.ml
 delete mode 100644 html/jAdd.mli
 delete mode 100644 html/jSmoothTrajectories.ml
 delete mode 100644 html/jSmoothTrajectories.mli
 delete mode 100644 html/script.js

diff --git a/_CoqProject b/_CoqProject
index 2e74d0f..776c18d 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -24,6 +24,7 @@ theories/axiomsKnuth.v
 theories/preliminaries_hull.v
 
 -R theories trajectories
+-R ../infotheo infotheo 
 
 -arg -w -arg -notation-overridden
 -arg -w -arg -ambiguous-paths
diff --git a/html/Add.html b/html/Add.html
deleted file mode 100755
index aefc4fa..0000000
--- a/html/Add.html
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-<HTML>
-
-    <HEAD>
-
-        <TITLE>Add</TITLE>
-
-    </HEAD><BODY>
-
-        <H1> Add </H1>
-       
-        <p>
-	        <script src="Add.js"></script>
-	        <script src="AddScript.js"></script>
-  </div>
-  <div>
-    <textarea id="text" name="text"
-          rows="1" cols="33">
-1 2 1 2 
-</textarea>
-<p>
-  <button onclick="myadd()" class="Clear"> Test </button>
- </div>
-</div>
-        </p>
-
-    </BODY>
-
-</HTML>
diff --git a/html/Add.ml b/html/Add.ml
deleted file mode 100644
index c94be3b..0000000
--- a/html/Add.ml
+++ /dev/null
@@ -1,403 +0,0 @@
-
-type nat =
-| O
-| S of nat
-
-type ('a, 'b) prod =
-| Pair of 'a * 'b
-
-(** val snd : ('a1, 'a2) prod -> 'a2 **)
-
-let snd = function
-| Pair (_, y) -> y
-
-type 'a list =
-| Nil
-| Cons of 'a * 'a list
-
-type comparison =
-| Eq
-| Lt
-| Gt
-
-module Coq__1 = struct
- (** val add : nat -> nat -> nat **)
- let rec add n m =
-   match n with
-   | O -> m
-   | S p -> S (add p m)
-end
-include Coq__1
-
-type positive =
-| XI of positive
-| XO of positive
-| XH
-
-type z =
-| Z0
-| Zpos of positive
-| Zneg of positive
-
-module Pos =
- struct
-  type mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
- end
-
-module Coq_Pos =
- struct
-  (** val succ : positive -> positive **)
-
-  let rec succ = function
-  | XI p -> XO (succ p)
-  | XO p -> XI p
-  | XH -> XO XH
-
-  (** val add : positive -> positive -> positive **)
-
-  let rec add x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XI (add p q0)
-       | XO q0 -> XO (add p q0)
-       | XH -> XI p)
-    | XH -> (match y with
-             | XI q0 -> XO (succ q0)
-             | XO q0 -> XI q0
-             | XH -> XO XH)
-
-  (** val add_carry : positive -> positive -> positive **)
-
-  and add_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XI (add_carry p q0)
-       | XO q0 -> XO (add_carry p q0)
-       | XH -> XI (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XH ->
-      (match y with
-       | XI q0 -> XI (succ q0)
-       | XO q0 -> XO (succ q0)
-       | XH -> XI XH)
-
-  (** val pred_double : positive -> positive **)
-
-  let rec pred_double = function
-  | XI p -> XI (XO p)
-  | XO p -> XI (pred_double p)
-  | XH -> XH
-
-  type mask = Pos.mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
-
-  (** val succ_double_mask : mask -> mask **)
-
-  let succ_double_mask = function
-  | IsNul -> IsPos XH
-  | IsPos p -> IsPos (XI p)
-  | IsNeg -> IsNeg
-
-  (** val double_mask : mask -> mask **)
-
-  let double_mask = function
-  | IsPos p -> IsPos (XO p)
-  | x0 -> x0
-
-  (** val double_pred_mask : positive -> mask **)
-
-  let double_pred_mask = function
-  | XI p -> IsPos (XO (XO p))
-  | XO p -> IsPos (XO (pred_double p))
-  | XH -> IsNul
-
-  (** val sub_mask : positive -> positive -> mask **)
-
-  let rec sub_mask x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask p q0)
-       | XO q0 -> succ_double_mask (sub_mask p q0)
-       | XH -> IsPos (XO p))
-    | XO p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XH -> (match y with
-             | XH -> IsNul
-             | _ -> IsNeg)
-
-  (** val sub_mask_carry : positive -> positive -> mask **)
-
-  and sub_mask_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XO p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask_carry p q0)
-       | XO q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XH -> double_pred_mask p)
-    | XH -> IsNeg
-
-  (** val sub : positive -> positive -> positive **)
-
-  let sub x y =
-    match sub_mask x y with
-    | IsPos z0 -> z0
-    | _ -> XH
-
-  (** val mul : positive -> positive -> positive **)
-
-  let rec mul x y =
-    match x with
-    | XI p -> add y (XO (mul p y))
-    | XO p -> XO (mul p y)
-    | XH -> y
-
-  (** val size_nat : positive -> nat **)
-
-  let rec size_nat = function
-  | XI p0 -> S (size_nat p0)
-  | XO p0 -> S (size_nat p0)
-  | XH -> S O
-
-  (** val compare_cont : comparison -> positive -> positive -> comparison **)
-
-  let rec compare_cont r x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> compare_cont r p q0
-       | XO q0 -> compare_cont Gt p q0
-       | XH -> Gt)
-    | XO p ->
-      (match y with
-       | XI q0 -> compare_cont Lt p q0
-       | XO q0 -> compare_cont r p q0
-       | XH -> Gt)
-    | XH -> (match y with
-             | XH -> r
-             | _ -> Lt)
-
-  (** val compare : positive -> positive -> comparison **)
-
-  let compare =
-    compare_cont Eq
-
-  (** val ggcdn :
-      nat -> positive -> positive -> (positive, (positive, positive) prod)
-      prod **)
-
-  let rec ggcdn n a b =
-    match n with
-    | O -> Pair (XH, (Pair (a, b)))
-    | S n0 ->
-      (match a with
-       | XI a' ->
-         (match b with
-          | XI b' ->
-            (match compare a' b' with
-             | Eq -> Pair (a, (Pair (XH, XH)))
-             | Lt ->
-               let Pair (g, p) = ggcdn n0 (sub b' a') a in
-               let Pair (ba, aa) = p in
-               Pair (g, (Pair (aa, (add aa (XO ba)))))
-             | Gt ->
-               let Pair (g, p) = ggcdn n0 (sub a' b') b in
-               let Pair (ab, bb) = p in
-               Pair (g, (Pair ((add bb (XO ab)), bb))))
-          | XO b0 ->
-            let Pair (g, p) = ggcdn n0 a b0 in
-            let Pair (aa, bb) = p in Pair (g, (Pair (aa, (XO bb))))
-          | XH -> Pair (XH, (Pair (a, XH))))
-       | XO a0 ->
-         (match b with
-          | XI _ ->
-            let Pair (g, p) = ggcdn n0 a0 b in
-            let Pair (aa, bb) = p in Pair (g, (Pair ((XO aa), bb)))
-          | XO b0 -> let Pair (g, p) = ggcdn n0 a0 b0 in Pair ((XO g), p)
-          | XH -> Pair (XH, (Pair (a, XH))))
-       | XH -> Pair (XH, (Pair (XH, b))))
-
-  (** val ggcd :
-      positive -> positive -> (positive, (positive, positive) prod) prod **)
-
-  let ggcd a b =
-    ggcdn (Coq__1.add (size_nat a) (size_nat b)) a b
- end
-
-module Z =
- struct
-  (** val double : z -> z **)
-
-  let double = function
-  | Z0 -> Z0
-  | Zpos p -> Zpos (XO p)
-  | Zneg p -> Zneg (XO p)
-
-  (** val succ_double : z -> z **)
-
-  let succ_double = function
-  | Z0 -> Zpos XH
-  | Zpos p -> Zpos (XI p)
-  | Zneg p -> Zneg (Coq_Pos.pred_double p)
-
-  (** val pred_double : z -> z **)
-
-  let pred_double = function
-  | Z0 -> Zneg XH
-  | Zpos p -> Zpos (Coq_Pos.pred_double p)
-  | Zneg p -> Zneg (XI p)
-
-  (** val pos_sub : positive -> positive -> z **)
-
-  let rec pos_sub x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> double (pos_sub p q0)
-       | XO q0 -> succ_double (pos_sub p q0)
-       | XH -> Zpos (XO p))
-    | XO p ->
-      (match y with
-       | XI q0 -> pred_double (pos_sub p q0)
-       | XO q0 -> double (pos_sub p q0)
-       | XH -> Zpos (Coq_Pos.pred_double p))
-    | XH ->
-      (match y with
-       | XI q0 -> Zneg (XO q0)
-       | XO q0 -> Zneg (Coq_Pos.pred_double q0)
-       | XH -> Z0)
-
-  (** val add : z -> z -> z **)
-
-  let add x y =
-    match x with
-    | Z0 -> y
-    | Zpos x' ->
-      (match y with
-       | Z0 -> x
-       | Zpos y' -> Zpos (Coq_Pos.add x' y')
-       | Zneg y' -> pos_sub x' y')
-    | Zneg x' ->
-      (match y with
-       | Z0 -> x
-       | Zpos y' -> pos_sub y' x'
-       | Zneg y' -> Zneg (Coq_Pos.add x' y'))
-
-  (** val mul : z -> z -> z **)
-
-  let mul x y =
-    match x with
-    | Z0 -> Z0
-    | Zpos x' ->
-      (match y with
-       | Z0 -> Z0
-       | Zpos y' -> Zpos (Coq_Pos.mul x' y')
-       | Zneg y' -> Zneg (Coq_Pos.mul x' y'))
-    | Zneg x' ->
-      (match y with
-       | Z0 -> Z0
-       | Zpos y' -> Zneg (Coq_Pos.mul x' y')
-       | Zneg y' -> Zpos (Coq_Pos.mul x' y'))
-
-  (** val sgn : z -> z **)
-
-  let sgn = function
-  | Z0 -> Z0
-  | Zpos _ -> Zpos XH
-  | Zneg _ -> Zneg XH
-
-  (** val abs : z -> z **)
-
-  let abs = function
-  | Zneg p -> Zpos p
-  | x -> x
-
-  (** val to_pos : z -> positive **)
-
-  let to_pos = function
-  | Zpos p -> p
-  | _ -> XH
-
-  (** val ggcd : z -> z -> (z, (z, z) prod) prod **)
-
-  let ggcd a b =
-    match a with
-    | Z0 -> Pair ((abs b), (Pair (Z0, (sgn b))))
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
-       | Zpos b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zpos aa), (Zpos bb))))
-       | Zneg b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zpos aa), (Zneg bb)))))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
-       | Zpos b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zneg aa), (Zpos bb))))
-       | Zneg b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zneg aa), (Zneg bb)))))
- end
-
-type q = { qnum : z; qden : positive }
-
-(** val qplus : q -> q -> q **)
-
-let qplus x y =
-  { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
-    qden = (Coq_Pos.mul x.qden y.qden) }
-
-(** val qred : q -> q **)
-
-let qred q0 =
-  let { qnum = q1; qden = q2 } = q0 in
-  let Pair (r1, r2) = snd (Z.ggcd q1 (Zpos q2)) in
-  { qnum = r1; qden = (Z.to_pos r2) }
-
-(** val a_val : q list **)
-
-let a_val =
-  Cons ({ qnum = (Zpos XH); qden = XH }, Nil)
-
-(** val sum_val_rec : q list -> q **)
-
-let rec sum_val_rec = function
-| Nil -> { qnum = Z0; qden = XH }
-| Cons (a, l0) -> qred (qplus a (sum_val_rec l0))
-
-(** val sum_val : q list -> q list **)
-
-let sum_val l =
-  Cons ((sum_val_rec l), Nil)
diff --git a/html/AddScript.js b/html/AddScript.js
deleted file mode 100644
index eee5860..0000000
--- a/html/AddScript.js
+++ /dev/null
@@ -1,4 +0,0 @@
-function myadd() {
-  let v = document.getElementById("text").value;
- window.alert(add(v));
-}
diff --git a/html/Makefile.coq.local b/html/Makefile.coq.local
deleted file mode 100644
index 7083bfd..0000000
--- a/html/Makefile.coq.local
+++ /dev/null
@@ -1,62 +0,0 @@
-post-all::
-	$(MAKE) -f $(SELF) Add.mli SmoothTrajectories.mli
-clean::
-	rm -f Add.mli
-
-Add.mli : add.vo
-	echo "mli"
-post-all::
-		$(MAKE) -f $(SELF) Add.ml
-clean::
-		rm -f Add.ml
-Add.ml : add.vo
-		echo "ml"
-
-post-all::
-	$(MAKE) -f $(SELF) Add.cmi SmoothTrajectories.cmi
-
-clean::
-	rm -f Add.cmi Add.cmo jAdd.cmi jAdd.cmo SmoothTrajectories.cmi SmoothTrajectories.cmo jSmoothTrajectories.cmi jSmoothTrajectories.cmo
-
-Add.cmi : Add.mli
-	ocamlfind ocamlc Add.mli
-
-SmoothTrajectories.ml SmoothTrajectories.mli : ../theories/smooth_trajectories.vo
-	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
-	cp ../theories/SmoothTrajectories.ml ../theories/SmoothTrajectories.mli .
-
-SmoothTrajectories.cmi : SmoothTrajectories.mli
-	ocamlfind ocamlc SmoothTrajectories.mli
-
-post-all::
-	$(MAKE) -f $(SELF) jAdd.cmi jSmoothTrajectories.cmi
-clean::
-	rm -f jAdd.cmi jSmoothTrajectories.cmi
-
-jAdd.cmi :  jAdd.ml
-	ocamlfind ocamlc jAdd.mli
-
-jSmoothTrajectories.cmi :  jSmoothTrajectories.ml
-	ocamlfind ocamlc jSmoothTrajectories.mli
-
-post-all::
-	$(MAKE) -f $(SELF) Add.bytes SmoothTrajectories.bytes
-clean::
-	rm -f Add.bytes SmoothTrajectories.bytes
-
-Add.bytes :  jAdd.cmi jAdd.ml Add.ml Add.cmi
-	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o Add.bytes Add.ml jAdd.ml
-
-SmoothTrajectories.bytes :  jSmoothTrajectories.cmi jSmoothTrajectories.ml SmoothTrajectories.ml SmoothTrajectories.cmi
-	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o SmoothTrajectories.bytes SmoothTrajectories.ml jSmoothTrajectories.ml
-
-post-all::
-	$(MAKE) -f $(SELF) Add.js SmoothTrajectories.js
-clean::
-	rm -f Add.js SmoothTrajectories.js
-
-Add.js :  Add.bytes
-	js_of_ocaml Add.bytes
-
-SmoothTrajectories.js :  SmoothTrajectories.bytes
-	js_of_ocaml --opt=3 SmoothTrajectories.bytes
diff --git a/html/add.v b/html/add.v
deleted file mode 100644
index 0d36de6..0000000
--- a/html/add.v
+++ /dev/null
@@ -1,14 +0,0 @@
-Require Import List QArith Extraction.
-
-
-Definition a_val := 1%Q :: nil.
-
-Fixpoint sum_val_rec l :=
- match l with a :: l =>     Qred (a + sum_val_rec l)%Q | _ => 0%Q end.
-
-Definition sum_val l := (sum_val_rec l) :: nil.
-
-Compute sum_val ((1#2)%Q :: (1#2)%Q :: nil).
-
-Extraction "Add.ml" a_val sum_val.
-
diff --git a/html/curve.html b/html/curve.html
deleted file mode 100755
index 6de55e6..0000000
--- a/html/curve.html
+++ /dev/null
@@ -1,27 +0,0 @@
-<html>
-	<head>
-		<meta charset="utf-8">
-		<title>Curve</title>
-    <style>
-      body {
-              overflow: hidden;
-              margin: 0px;
-           }
-    </style>
-    <script async
-      src="https://unpkg.com/es-module-shims@1.6.3/dist/es-module-shims.js">
-    </script>
-
-    <script type="importmap">
-      {
-        "imports": {
-        "three": "https://unpkg.com/three@0.150.1/build/three.module.js",
-        "three/addons/": "https://unpkg.com/three@0.150.1/examples/jsm/"
-        }
-      }
-    </script>
-	</head>
-  <body>
-  <script defer type="module" src="./script.js"></script>
-  </body>
-</html>
\ No newline at end of file
diff --git a/html/grid.html b/html/grid.html
deleted file mode 100755
index 118df43..0000000
--- a/html/grid.html
+++ /dev/null
@@ -1,46 +0,0 @@
-<html>
-	<head>
-		<meta charset="utf-8">
-		<title>Grid</title>
-    <style>
-      body {
-              overflow: hidden;
-              margin: 0px;
-           }
-    </style>
-    <script async
-      src="https://unpkg.com/es-module-shims@1.6.3/dist/es-module-shims.js">
-    </script>
-
-    <script type="importmap">
-      {
-        "imports": {
-        "three": "https://unpkg.com/three@0.150.1/build/three.module.js",
-        "three/addons/": "https://unpkg.com/three@0.150.1/examples/jsm/"
-        }
-      }
-    </script>
-	</head>
-  <body>
-<input type="radio" id="obstacles" name="modality" value="obstacles" checked="checked">
-<label for="Maze">Obstacles</label>
-<input type="radio" id="positions" name="modality" value="positions">
-<label for="Position">Starting and ending positions</label> 
-<input type="checkbox" id="cell" name="Show Cells">
-<label> Show Cells </label>
-<p>
-  To add an obstacle, click to a first end-point (blue square)
-  then click to the second end-point
-<p>
-  To remove an obstacle, click to a first end-point (blue square)
-  then click to the second end-point
-<p>
-  After giving the starting point and the ending point (positions) the system 
-  gives a path avoiding the obstacles.
-<p> 
-  To see the cells used by the algorithm, tick the Show Cell check-box
-</p>
-  <script defer type="module" src="./SmoothTrajectories.js"></script>
-  <script defer type="module" src="./grid.js"></script>
-  </body>
-</html>
\ No newline at end of file
diff --git a/html/grid.js b/html/grid.js
deleted file mode 100644
index 7281805..0000000
--- a/html/grid.js
+++ /dev/null
@@ -1,446 +0,0 @@
-import * as THREE from 'three';
-
-/* Size of the grid */
-const gSize  = 40;
-
-/* The render */
-const renderer = new THREE.WebGLRenderer();
-renderer.setSize(600, 600);
-document.body.insertBefore(renderer.domElement, document.body.firstChild);
-
-/* The camera */
-const camera = new THREE.PerspectiveCamera( 45, 1, 1, 500 );
-camera.position.set(0, 1.5 * gSize, 0);
-camera.lookAt( 0, 0, 0 );
-
-/* The scene */
-var scene = new THREE.Scene();
-scene.background = new THREE.Color( 'lightgrey' );
-
-/* The grid */
-var grid = new THREE.GridHelper(gSize, gSize);
-scene.add(grid);
-grid.position.z = 0;
-grid.position.y = 0.1;
-grid.position.x = 0;
-renderer.render( scene, camera );
-
-/* The board */
-const boardColor = new THREE.Color('white');
-const boardMat   = new THREE.MeshBasicMaterial({color: boardColor});
-const boardGeometry = new THREE.BoxGeometry(gSize,0.1, gSize);
-const boardCube = new THREE.Mesh(boardGeometry, boardMat);
-boardCube.position.z = 0;
-boardCube.position.y = 0;
-boardCube.position.x = 0;
-scene.add(boardCube);
-
-/* The From Square */
-var fromValid = false;
-var fromX = 0;
-var fromY = 0.2;
-var fromZ = 0;
-const fromColor = new THREE.Color('blue');
-const fromMat   = new THREE.MeshBasicMaterial({color: fromColor});
-// create the from Square
-const fromGeometry = new THREE.BoxGeometry(0.9, 0.1, 0.9);
-const fromCube = new THREE.Mesh(fromGeometry, fromMat);
-// The initial position
-fromCube.position.z = fromZ;
-fromCube.position.y = -0.2;
-fromCube.position.x = fromX;
-scene.add(fromCube);
-
-/* The To Square */
-var toValid = false;
-var fY = 0.2;
-var tY = 0.2;
-var toX = 0;
-var toY = 0.2;
-var toZ = 0;
-var toColor = new THREE.Color('red');
-const toMat   = new THREE.MeshBasicMaterial({color: toColor});
-// create the to Square
-const toGeometry = new THREE.BoxGeometry(0.9, 0.1, 0.9);
-const toCube = new THREE.Mesh(toGeometry, toMat);
-// The initial position
-toCube.position.z = toZ;
-toCube.position.y = -0.2;
-toCube.position.x = toX;
-scene.add(toCube);
-renderer.render( scene, camera );
-
-// The Borders 
-var  borders = [];
-borders.push({fX : - gSize/2, fZ : - gSize/2, tX : gSize/2, tZ : - gSize/2});
-borders.push({fX : - gSize/2, fZ :   gSize/2, tX : gSize/2, tZ :   gSize/2});
-
-// The obstacles 
-var  obstacles = [];
-const lineColor = new THREE.Color( 'green' );
-const lineMat = new THREE.LineBasicMaterial({color: lineColor, linewidth: 1});
-
-function addObstacle(fX, fZ, tX, tZ) {
-    if (tX < fX) {
-        let xX = fX;
-        let xZ = fZ;
-        fX = tX;
-        fZ = tZ;
-        tX = xX;
-        tZ = xZ;
-    }
-    console.log("addObstacle " + fX + " " + fZ + " " + tX + " " + tZ);
-    fromValid = false;  
-    toValid = false;   
-    fromCube.position.y = -0.2;
-    toCube.position.y = -0.2;
-    let test = false;
-    let index = 0;
-    let tline = null;
-    obstacles.every(item => {
-            if ((fX == item.fX) && (fZ == item.fZ) &&
-                (tX == item.tX) && (tZ == item.tZ)) {
-                test = true;
-                tline = item.line;
-                return false;
-            };
-            index++;
-            return true;
-    });
-    if (test) {
-        console.log("delete");
-        scene.remove(tline);
-        obstacles.splice(index, 1);
-        renderer.render( scene, camera ); 
-        cleanCells();
-        getCells();
-        return;
-    }
-    let fromVector = new THREE.Vector3(fX, fY, fZ ) ;
-    console.log(fromVector + "" + fX + " " + fY + " " + fZ);    
-    let toVector = new THREE.Vector3(tX, tY, tZ ) ;
-    console.log(toVector + "" + tX + " " + tY + " " + tZ);    
-    let points = [fromVector, toVector];
-    let geometry = new THREE.BufferGeometry().setFromPoints( points );
-    let vline = new THREE.Line( geometry, lineMat );
-    scene.add( vline );
-    const v = {fX : fX, fZ : fZ, tX : tX, tZ : tZ, line : vline };
-    obstacles.push(v);
-    renderer.render( scene, camera );
-    cleanCells();
-    getCells();     
-}
-
-
-/* The cells */
-var cells = [];
-var cellsFlag = true;
-
-const cellsButtons = 
-  document.querySelectorAll('input[name="Show Cells"]');
-
-for (const cellsButton of cellsButtons) {
-    cellsButton.addEventListener("click", setCells, false);
-}
-
-
-const dmaterial = new THREE.LineDashedMaterial( {
-	color: 'black',
-	dashSize: 0.4,
-	gapSize: 0.4,
-} );
-
-
-// Function to output a value v
-function outVal (v) {
-    let v1 = v + 0.5 + (gSize/2);
-    let val = "+" + (2 * v1) + " " + "+" + (2 * gSize) + " "
-    return val;
-}
-
-function getCells() {
-  if (!cellsFlag) {
-    return;
-  }
-  let val = "";
-  if (borders.length != 2) {
-    return;
-  }
-  if (borders[0].fZ <= borders[1].fZ) {
-    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
-           outVal(borders[0].tX) + outVal(borders[0].tZ);  
-    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
-           outVal(borders[1].tX) + outVal(borders[1].tZ);  
-  } else {
-    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
-           outVal(borders[1].tX) + outVal(borders[1].tZ);  
-    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
-           outVal(borders[0].tX) + outVal(borders[0].tZ);  
-  }
-  for (const obstacle of obstacles) {
-    val += outVal(obstacle.fX) + outVal(obstacle.fZ)
-            + outVal(obstacle.tX) + outVal(obstacle.tZ);  
-  } 
-  console.log("boarders " + borders.length + " obstacles " + obstacles.length);
-  console.log("val " + val);
-  let res = ocamlLib.cells(val);
-  console.log("res " + res);
-  let res1 = res.split(' ').map(Number);
-  console.log("res1 length" + res1.length);
-  console.log("res1[0]=" + res1[0]);
-  console.log("res1[res1.length - 1]=" + res1[res1.length - 1]);
-  let i = 0;
-  while (i < res1.length - 1) {
-    /* Straight line */
-    let fx = res1[i] / res1 [i + 1] * gSize - 0.5 - gSize/2;
-    let fy = 0.3;
-    let fz = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
-    let tx = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
-    let ty = 0.3;
-    let tz = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
-    console.log("Adding a dotted line" + fx + " " + fz + " " + tx + " " + tz);
-    let epoints = [];
-     epoints.push( new THREE.Vector3(fx, fy, fz) );
-     epoints.push( new THREE.Vector3(tx, ty, tz));
-    let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-    let sline = new THREE.Line( egeometry, dmaterial );
-    sline.computeLineDistances();
-    cells.push(sline);
-    scene.add( sline );
-    renderer.render( scene, camera );
-    i += 8;
-  }
-}
-
-function cleanCells () {
-    let i = 0; 
-    console.log("cells " + cells);
-    while (i < cells.length)
-    for (const cell of cells) {
-        scene.remove(cells[i]);
-        i++;
-    }
-    renderer.render( scene, camera ); 
-    cells = [];
-}
-
-function setCells() {
-    cleanCells();
-    cellsFlag = cellsButtons[0].checked;
-    if (cellsFlag) {
-      scene.remove(grid)
-    } else {
-      scene.add(grid);
-    }
-    renderer.render( scene, camera );
-    getCells();
-}
-
-setCells();
-
-/* The curve */
-
-var curves = [];
-const cmaterial = new THREE.LineBasicMaterial( { color: 'brown' } );
-
-function cleanCurve () {
-    let i = 0; 
-    console.log("curves " + curves);
-    while (i < curves.length)
-    for (const curve of curves) {
-        scene.remove(curve);
-        i++;
-    }
-    renderer.render( scene, camera ); 
-    curves = [];
-}
-
-function getCurve() {
-  let val = "";
-  val += outVal(positions.fX) + outVal(positions.fZ) + 
-         outVal(positions.tX) + outVal(positions.tZ);
-  if (borders.length != 2) {
-    return;
-  }
-  if (borders[0].fZ <= borders[1].fZ) {
-    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
-           outVal(borders[0].tX) + outVal(borders[0].tZ);  
-    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
-           outVal(borders[1].tX) + outVal(borders[1].tZ);  
-  } else {
-    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
-           outVal(borders[1].tX) + outVal(borders[1].tZ);  
-    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
-           outVal(borders[0].tX) + outVal(borders[0].tZ);  
-  }
-  for (const obstacle of obstacles) {
-    val += outVal(obstacle.fX) + outVal(obstacle.fZ)
-            + outVal(obstacle.tX) + outVal(obstacle.tZ);  
-  } 
-  console.log("boarders " + borders.length + " obstacles " + obstacles.length);
-  console.log("val " + val);
-  let res = ocamlLib.smooth(val);
-  console.log("res " + res);
-  let res1 = res.split(' ').map(Number);
-  let i = 0;
-  while (i < res1.length) {
-    if (res1[i] == 1) {
-        /* Straight line */
-        let fx = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
-        let fy = 0.3;
-        let fz = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
-        let tx = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
-        let ty = 0.3;
-        let tz = res1[i + 8] / res1 [i + 9] * gSize - 0.5 - gSize/2;
-        console.log("Adding a line" + fx + " " + fz + " " + tx + " " + tz);
-        let epoints = [];
-        epoints.push( new THREE.Vector3(fx, fy, fz) );
-        epoints.push( new THREE.Vector3(tx, ty, tz));
-        let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-        let sline = new THREE.Line( egeometry, cmaterial );
-        curves.push(sline);
-        scene.add( sline );
-        renderer.render( scene, camera );
-        i += 10;
-    } else if (res1[i] == 2) {
-        /* curve */
-        let fx = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
-        let fy = 0.3;
-        let fz = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
-        let cx = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
-        let cy = 0.3;
-        let cz = res1[i + 8] / res1 [i + 9] * gSize - 0.5 - gSize/2;
-        let tx = res1[i + 10] / res1 [i + 11] * gSize - 0.5 - gSize/2;
-        let ty = 0.3;
-        let tz = res1[i + 12] / res1 [i + 13] * gSize - 0.5 - gSize/2;
-        console.log("Adding a curve" + fx + " " + fz + " " 
-                                     + cx + " " + cz + " " + tx + " " + tz);
-        let ccurve = new THREE.QuadraticBezierCurve3(
-                	new THREE.Vector3(fx, fy, fz ),
-	                new THREE.Vector3(cx, cy, cz ),
-	                new THREE.Vector3(tx, ty, tz )
-                );
-        let cpoints = ccurve.getPoints( 50 );
-        let cgeometry = new THREE.BufferGeometry().setFromPoints( cpoints );
-        let cline = new THREE.Line( cgeometry, cmaterial );
-        scene.add( cline );
-        curves.push(cline);
-        i += 14;
-    } else {
-        i++;
-    }
-  }
-}
-
-
-/* The modality */
-
-var modality = "";
-
-const radioButtons = 
-  document.querySelectorAll('input[name="modality"]');
-
-for (const radioButton of radioButtons) {
-    radioButton.addEventListener("click", setModality, false);
-}
-
-function setModality() {
-    cleanCurve();
-    fromValid = false;  
-    toValid = false;         
-    fromCube.position.y = -0.2;
-    toCube.position.y = -0.2;
-    renderer.render( scene, camera );        
-    for (const radioButton of radioButtons) {
-        if (radioButton.checked) {
-            modality = radioButton.value;
-            console.log("new modality " + modality);
-            break;
-        }
-    }
-}
- 
-setModality();
-
-
-/* The mouse */
-var mouse = new THREE.Vector2();
-var raycaster = new THREE.Raycaster();
-renderer.domElement.addEventListener('click', onDocumentMouseDown, false);
-// store the from and to position 
-var positions;
-
-function onDocumentMouseDown( event ) {
-
-    // Get screen-space x/y
-    mouse.x = ( event.clientX / renderer.domElement.clientWidth ) * 2 - 1;
-    mouse.y = - ( event.clientY / renderer.domElement.clientHeight ) * 2 + 1;
-
-    // Perform raycast
-    raycaster.setFromCamera( mouse, camera );
-
-    // See if the ray from the camera into the world hits our mesh
-    const intersects = raycaster.intersectObject( boardCube );
-
-    // Check if an intersection took place
-    if ( intersects.length == 0 ) {
-        return;
-    }
-    let posX = intersects[0].point.x;
-    let posZ = intersects[0].point.z;
-    let dZ = Math.abs(Math.trunc(posZ) - posZ);
-    let dX = Math.abs(Math.trunc(posX) - posX);
-/*    if (((dZ < 0.05) || (0.95 < dZ)) || (dX < 0.05) || (0.95 < dX)) {
-        return;
-    }
-*/
-    if (toValid && (modality == "positions")) {
-        fromValid = false;
-        toValid = false;
-        fromCube.position.y = -0.2;
-        toCube.position.y = -0.2;
-        cleanCurve();
-        renderer.render( scene, camera );  
-    }
-    if (fromValid) {
-        toZ = Math.round(gSize + posZ + 0.5) -gSize - 0.5;
-        toX = Math.round(gSize + posX + 0.5) -gSize - 0.5;
-        if ((fromX == toX) && (fromZ != toZ) && (modality == "obstacles")) {
-            return;
-        }
-        console.log("modality = " + modality);
-        if (modality == "obstacles") {
-            fromValid = false;  
-            toValid = true;         
-            if ((fromX == toX) && (fromZ == toZ)) {
-                fromCube.position.y = -0.2;
-                toCube.position.y = -0.2;
-                renderer.render( scene, camera ); 
-                return;
-            }
-            cleanCurve();
-            addObstacle(fromX, fromZ, toX, toZ);
-        }
-        if (modality == "positions") {
-            fromValid = true;         
-            toValid = true;         
-            toCube.position.z = toZ;
-            toCube.position.y = toY;
-            toCube.position.x = toX;
-            renderer.render( scene, camera );
-            positions = {fX : fromX, fZ : fromZ, tX : toX, tZ : toZ }
-            cleanCurve();
-            getCurve();
-        }
-    } else {
-        fromValid = true;         
-        fromZ = Math.round(gSize + posZ + 0.5) -gSize - 0.5;
-        fromX = Math.round(gSize + posX + 0.5) -gSize - 0.5;
-        fromCube.position.z = fromZ;
-        fromCube.position.y = fromY;
-        fromCube.position.x = fromX;
-        toCube.position.y = -0.2;
-        cleanCurve();
-        renderer.render( scene, camera );
-    }
-}
diff --git a/html/jAdd.ml b/html/jAdd.ml
deleted file mode 100644
index a57188e..0000000
--- a/html/jAdd.ml
+++ /dev/null
@@ -1,57 +0,0 @@
-(** link code **)
-
-open Js_of_ocaml
-open Add
-
-let rec n2pos n = if n < 2 then XH else 
-                  if n mod 2 == 0 then 
-                  XO (n2pos (n / 2)) else XI (n2pos (n / 2))
-
-let rec pos2n n = 
-  match n with XH -> 1 | XO n -> 2 * (pos2n n) | XI n -> 2 * (pos2n n) + 1
-
-let n2z n = if n = 0 then Z0 else 
-            if 0 < n then Zpos (n2pos n)
-            else Zneg (n2pos n)
-
-let z2n n = match n with
-| Z0 -> 0
-| Zpos n -> pos2n n
-| Zneg n -> - pos2n n
-
-let string2lr s =
-  let le = String.length s in
-  let rec iter i si vi = if i = le then Nil else
-    let v = String.get s i in 
-    if (v == '-') then iter (i + 1) (-1) vi else
-    if (v == '+') then iter (i + 1) (1) vi else
-    if (v == ' ') then Cons (n2z (si * vi), iter (i + 1) 1 0) else
-    iter (i + 1) si (vi * 10 + (Char.code v - 48)) in
-  iter 0 1 0
-
-let rec string2lr1 l = 
-match l with 
-| Cons (n , Cons (Z0, l)) -> Cons ({qnum = n; qden = XH}, (string2lr1 l))
-| Cons (n, Cons (Zpos d, l)) -> Cons ({qnum = n; qden = d}, (string2lr1 l))
-| _ -> Nil
-
-let string2l s = string2lr1 (string2lr s)
-
-let rec l2stringr s l =
-  match l with
-    Nil -> s
-  | Cons (n,l) ->  l2stringr (s ^ (string_of_int (z2n n.qnum)) ^ " " ^
-                                  (string_of_int (pos2n n.qden)) ^ " ")
-                             l
-
-let l2string l = l2stringr "" l
-
-let main s =
-  let l = string2l s in l2string (sum_val l)
-
-let _ =
-  Js.export_all
-    (object%js
-      method add s = Js.string (main (Js.to_string s))
-    end)
-
diff --git a/html/jAdd.mli b/html/jAdd.mli
deleted file mode 100644
index 2fe4da4..0000000
--- a/html/jAdd.mli
+++ /dev/null
@@ -1,6 +0,0 @@
-open Add
-
-val n2pos : int -> positive
-val pos2n : positive -> int
-val n2z : int -> z
-val z2n : z -> int
diff --git a/html/jSmoothTrajectories.ml b/html/jSmoothTrajectories.ml
deleted file mode 100644
index 67f8520..0000000
--- a/html/jSmoothTrajectories.ml
+++ /dev/null
@@ -1,137 +0,0 @@
-(** link code **)
-
-open Js_of_ocaml
-open SmoothTrajectories
-
-let rec n2pos n = if n < 2 then XH else 
-                  if n mod 2 == 0 then 
-                  XO (n2pos (n / 2)) else XI (n2pos (n / 2))
-
-let rec pos2n n = 
-  match n with XH -> 1 | XO n -> 2 * (pos2n n) | XI n -> 2 * (pos2n n) + 1
-
-let n2z n = if n = 0 then Z0 else 
-            if 0 < n then Zpos (n2pos n)
-            else Zneg (n2pos n)
-
-let z2n n = match n with
-| Z0 -> 0
-| Zpos n -> pos2n n
-| Zneg n -> - pos2n n
-
-let n2q n d = {qnum = n2z n; qden = n2pos d}
-
-let q2n v =
-let v1 = qred v in  [z2n v1.qnum; pos2n v1.qden]
-
-let n2pt n1 d1 n2 d2 = {p_x = n2q n1 d1; p_y = n2q n2 d2}
-
-let pt2n p = (q2n p.p_x) @ (q2n p.p_y)
-
-let n2edge n1 d1 n2 d2 n3 d3 n4 d4 = 
-  if (n1 <= n3) then
-  { left_pt = n2pt n1 d1 n2 d2; right_pt = n2pt n3 d3 n4 d4}
-  else 
-  { left_pt = n2pt n3 d3 n4 d4; right_pt = n2pt n1 d1 n2 d2}
-  
-let edge2n e = (pt2n e.left_pt) @ (pt2n e.right_pt)
-
-let string2ln s =
-  let le = String.length s in
-  let rec iter i si vi = if i = le then [] else
-    let v = String.get s i in 
-    if (v == '-') then iter (i + 1) (-1) vi else
-    if (v == '+') then iter (i + 1) (1) vi else
-    if (v == ' ') then (si * vi) :: iter (i + 1) 1 0 else
-    iter (i + 1) si (vi * 10 + (Char.code v - 48)) in
-  iter 0 1 0
-
-let rec list2es l = 
-  match l with
-  | en1 :: ed1 :: en2 :: ed2 :: en3 :: ed3 :: en4 :: ed4 :: l1
-    ->
-      Cons (n2edge en1 ed1 en2 ed2 en3 ed3 en4 ed4, list2es l1)
-  | [] -> Nil
-
-
-let annotated_point2n ap = pt2n ap.apt_val
-    
-let curve_element2n ce =
-  match ce with
-| Straight (ap1, ap2) -> 1 :: 0 :: (annotated_point2n ap1 @ annotated_point2n ap2)
-| Bezier (ap1, ap2, ap3) ->
-    2 :: 0 :: (annotated_point2n ap1 @ annotated_point2n ap2 @ annotated_point2n ap3)
-
-let rec curve_elements2n ces =
-  match ces with
-  |  Cons (ce, ces1) -> curve_element2n ce @ curve_elements2n ces1 
-  |  Nil -> []
-
-let rec l2stringr l =
-  match l with
-    [] -> ""
-  | a :: l1 -> if (0 <= a) then 
-               ("+" ^ (string_of_int a) ^ " " ^ l2stringr l1)
-               else 
-               ((string_of_int a) ^ " " ^ l2stringr l1)
-
-let call_smooth s = 
-  let l = string2ln s in
-  match l with
-  | p1n1 :: p1d1 :: p1n2 :: p1d2 :: p2n1 :: p2d1 :: p2n2 ::p2d2 ::
-    e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
-    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
-    ls ->
-    let es = list2es ls in 
-    let v = qsmooth_point_to_point (n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4)
-      (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4)
-      es 
-      (n2pt p1n1 p1d1 p1n2 p1d2)
-      (n2pt p2n1 p2d1 p2n2 p2d2) in 
-    l2stringr (curve_elements2n v)
-
-
-let call_smooth1 s = 
-  let l = string2ln s in
-  match l with
-  | p1n1 :: p1d1 :: p1n2 :: p1d2 :: p2n1 :: p2d1 :: p2n2 ::p2d2 ::
-    e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
-    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
-    ls ->
-    let es = list2es ls in 
- ((n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4),
-  (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4),
-      es ,
-      (n2pt p1n1 p1d1 p1n2 p1d2),
-      (n2pt p2n1 p2d1 p2n2 p2d2)) 
-
-let rec cells_element2n ce =
-  match ce with
-  | Nil -> []
-  | Cons (a, Nil) -> []
-  | Cons (a, Cons (b, Nil)) -> pt2n a @ pt2n b
-  | Cons (a, Cons (b, c)) -> cells_element2n (Cons (a, c))
-  
-let rec cells_elements2n ces =
-  match ces with
-  |  Cons (ce, ces1) -> cells_element2n (ce.left_pts) @ cells_elements2n ces1 
-  |  Nil -> []
-
-let call_cells s = 
-  let l = string2ln s in
-  match l with
-  | e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
-    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
-    ls ->
-    let es = list2es ls in 
-    let v = qedges_to_cells (n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4)
-      (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4)
-      es  in 
-    l2stringr (cells_elements2n v)
-
-let _ =
-  Js.export "ocamlLib"
-    (object%js
-      method smooth s = Js.string (call_smooth (Js.to_string s))
-      method cells s = Js.string (call_cells (Js.to_string s))
-    end)
diff --git a/html/jSmoothTrajectories.mli b/html/jSmoothTrajectories.mli
deleted file mode 100644
index 1d2f275..0000000
--- a/html/jSmoothTrajectories.mli
+++ /dev/null
@@ -1,6 +0,0 @@
-open SmoothTrajectories
-
-val n2pos : int -> positive
-val pos2n : positive -> int
-val n2z : int -> z
-val z2n : z -> int
diff --git a/html/script.js b/html/script.js
deleted file mode 100644
index a0e24cb..0000000
--- a/html/script.js
+++ /dev/null
@@ -1,171 +0,0 @@
-import * as THREE from 'three';
-import { FontLoader } from 'three/addons/loaders/FontLoader.js';
-import { TextGeometry } from 'three/addons/geometries/TextGeometry.js';
-
-const renderer = new THREE.WebGLRenderer();
-renderer.setSize( window.innerWidth, window.innerHeight );
-document.body.appendChild( renderer.domElement );
-
-const camera = new THREE.PerspectiveCamera( 45, window.innerWidth / window.innerHeight, 1, 500 );
-camera.position.set( 0, 0, 10 );
-camera.lookAt( 0, 0, 0 );
-
-const scene = new THREE.Scene();
-scene.background = new THREE.Color( 'lightgrey' );
-
-//create a blue LineBasicMaterial
-const material = new THREE.LineBasicMaterial( { color: 'black' } );
-const cmaterial = new THREE.LineBasicMaterial( { color: 'red' } );
-
-/* 
-BOTTOM
-  ({| left_pt := {| p_x := -4; p_y := -4|};
-      right_pt := {| p_x := 4; p_y := -4|}|}).
-
-*/
-
-const bpoints = [];
-bpoints.push( new THREE.Vector3( - 4, - 4, 0 ) );
-bpoints.push( new THREE.Vector3(   4, - 4, 0 ) );
-
-const bgeometry = new THREE.BufferGeometry().setFromPoints( bpoints );
-
-const bline = new THREE.Line( bgeometry, material );
-
-scene.add( bline );
-
-/* 
-Notation TOP :=
-  ({| left_pt := {| p_x := -4; p_y := 2|};
-      right_pt := {| p_x := 4; p_y := 2|}|}).
-
-*/
-
-const tpoints = [];
-tpoints.push( new THREE.Vector3( - 4, 2, 0 ) );
-tpoints.push( new THREE.Vector3(   4, 2, 0 ) );
-
-const tgeometry = new THREE.BufferGeometry().setFromPoints( tpoints );
-
-const tline = new THREE.Line( tgeometry, material );
-
-scene.add( tline );
-
-/* 
-Definition example_edge_list : seq edge :=
-  Bedge (Bpt (-3) 0) (Bpt (-2) 1) ::
-  Bedge (Bpt (-3) 0) (Bpt 0 (-3)) ::
-  Bedge (Bpt 0 (-3)) (Bpt 3 0) ::
-  Bedge (Bpt (-2) 1) (Bpt 0 1) ::
-  Bedge (Bpt 0 1) (Bpt 1 0) ::
-  Bedge (Bpt (-1) 0) (Bpt 0 (-1)) ::
-  Bedge (Bpt 0 (-1)) (Bpt 1 0) :: nil.
-*/
-
-const edge_list = [
-  {fx : -3, fy : 0, tx : -2, ty : 1},  
-  {fx : -3, fy : 0, tx :  0, ty : -3},
-  {fx :  0, fy : -3, tx : 3, ty : 0},
-  {fx :  -2, fy : 1, tx : 0, ty : 1},
-  {fx :  0, fy : 1, tx : 1, ty : 0},
-  {fx :  -1, fy : 0, tx : 0, ty : -1},
-  {fx :  0, fy : -1, tx : 1, ty : 0}
-];
-
-edge_list.forEach(add_edge);
-
-function add_edge(edge) {
-  let epoints = [];
-  epoints.push( new THREE.Vector3(edge.fx, edge.fy, 0 ) );
-  epoints.push( new THREE.Vector3(edge.tx, edge.ty, 0 ) );
-  let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-  let eline = new THREE.Line( egeometry, material );
-  scene.add( eline );
-}
-
-/* curve
-	 = straight {| p_x := -1.9; p_y := -3 # 2 |};
-              {| p_x := -19 # 20; p_y := -480 # 192 |} :: 
-      bezier  {| p_x := -19 # 20; p_y := -480 # 192 |};
-              {| p_x := 0; p_y := -168 # 48 |}
-              {| p_x := 3 # 2; p_y := -12672 # 4608 |}; ::
-      bezier  {| p_x := 3 # 2; p_y := -12672 # 4608 |};
-              {| p_x := 3; p_y := -96 # 48 |}
-              {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |} :: 
-      bezier  {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |}
-              {| p_x := 28 # 8; p_y := (-0x1.000)%xQ |}
-              {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}  ::
-      bezier  {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}
-              {| p_x := 3; p_y := 0x1.0%xQ |}
-              {| p_x := 4 # 2; p_y := 0 # 192 |} ::
-      bezier  {| p_x := 4 # 2; p_y := 0 # 192 |}
-              {| p_x := 1; p_y := -6 # 6 |}
-              {| p_x := 1 # 2; p_y := -36 # 24 |} ::
-      bezier  {| p_x := 1 # 2; p_y := -36 # 24 |}
-              {| p_x := 0; p_y := -4 # 2 |}
-              {| p_x := -1 # 2; p_y := -36 # 24 |}
-      bezier  {| p_x := -1 # 2; p_y := -36 # 24 |}
-              {| p_x := -1; p_y := -6 # 6 |}
-              {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |} ::
-      bezier  {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |}
-              {| p_x := -12 # 8; p_y := -36 # 144 |}
-              {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |} ::
-      bezier  {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |}
-              {| p_x := -1; p_y := 2 # 4 |}
-              {| p_x := -1 # 2; p_y := 8 # 32 |} ::
-      bezier  {| p_x := -1 # 2; p_y := 8 # 32 |};
-               ({| p_x := 0; p_y := 0|}).
-              {| p_x := 1 # 6; p_y := 0 # 8 |} ::
-      straight {| p_x := 1 # 6; p_y := 0 # 8 |};
-               {| p_x := 1 # 3; p_y := 0 |};
-*/
-
-const curve_list = [
-  {b : false, fx : -1.9, fy : -(3/2), tx : -(19/20), ty : - (480 / 192)},  
-  {b : true, fx : -(19/20), fy : -(480/192), 
-             cx : 0, cy : -(168/48), tx : (3/2), ty : -(12672/4608)},
- {b : true, fx : (3/2), fy : -(12672/4608), 
-             cx : 3, cy : -(96/48), tx : (3 + 4/16), ty : -(589824/393216)},
- {b : true, fx : (3 + 4 /16), fy : -(589824/393216), 
-             cx : (28/8), cy : -(1), tx : (3 + 4/16), ty : 0},
- {b : true, fx : (3 + 4/16), fy : 0, 
-             cx : 3, cy : 1.0, tx : (4/2), ty : 0},
- {b : true, fx : (4/2), fy : 0, 
-             cx : 1, cy : -(6/6), tx : (1/2), ty : -(36/24)},
- {b : true, fx : (1/2), fy : -(36/24), 
-             cx : 0, cy : -(4/2), tx : -(1/2), ty : -(36/24)},
- {b : true, fx : -(1/2), fy : -(36/24), 
-             cx : -1, cy : -(6/6), tx : -(1 + 4 / 16), ty : -(1080/1728)},
- {b : true, fx : -(1 + 4 / 16), fy : -(1080/1728), 
-             cx : -(12/8), cy : -(36/144), tx : -(1 + 4/16), ty : (144/1152)},
- {b : true, fx : -(1 + 4 / 16), fy : (144/1152), 
-             cx : -1, cy : (2/4), tx : -(1/2), ty : (8/32)},
- {b : true, fx : -(1/2), fy : (8/32), 
-             cx : 0, cy : 0, tx : (1/6), ty : 0},
-  {b : false, fx : (1/6), fy : 0, tx : (1/3), ty : 0}  
-];
-
-curve_list.forEach(add_curve);
-
-function add_curve(curve) {
-  if (curve.b) {
-    let ccurve = new THREE.QuadraticBezierCurve3(
-                	new THREE.Vector3(curve.fx, curve.fy, 0 ),
-	                new THREE.Vector3(curve.cx, curve.cy, 0 ),
-	                new THREE.Vector3(curve.tx, curve.ty, 0 )
-                );
-    let cpoints = ccurve.getPoints( 50 );
-    let cgeometry = new THREE.BufferGeometry().setFromPoints( cpoints );
-    let cline = new THREE.Line( cgeometry, cmaterial );
-    scene.add( cline );
-  } else {
-    let epoints = [];
-    epoints.push( new THREE.Vector3(curve.fx, curve.fy, 0 ) );
-    epoints.push( new THREE.Vector3(curve.tx, curve.ty, 0 ) );
-    let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-    let sline = new THREE.Line( egeometry, cmaterial );
-    scene.add( sline );
-  }
-}
-
-renderer.render( scene, camera );
diff --git a/theories/convex.v b/theories/convex.v
index 7f9b303..0b1ed8a 100644
--- a/theories/convex.v
+++ b/theories/convex.v
@@ -1,6 +1,7 @@
-From mathcomp Require Import all_ssreflect all_algebra vector reals ereal.
-From mathcomp Require Import classical_sets boolp Rstruct.
-From infotheo Require Import Reals_ext fdist convex.
+From HB Require Import structures.
+From mathcomp Require Import all_ssreflect all_algebra vector mathcomp_extra.
+From mathcomp Require Import reals ereal classical_sets boolp Rstruct lra.
+From infotheo Require Import ssrR Reals_ext realType_ext fdist convex.
 Require Import preliminaries.
 
 Import Order.POrderTheory Order.TotalTheory GRing.Theory Num.Theory preliminaries.
@@ -39,7 +40,7 @@ Proof.
 rewrite eqEsubset; split.
    move=>+ [n][/=g][/=d][gCD]-> =>_.
    rewrite Convn_pair; split=>/=;
-      exists n; [exists (fst \o g) | exists (snd \o g)]; exists d; split=> // + [i] _ <- =>_ /=;
+      exists n; [exists (Datatypes.fst \o g) | exists (Datatypes.snd \o g)]; exists d; split=> // + [i] _ <- =>_ /=;
       (suff: ((C `*` D) (g i)) by move=>[]);
       by apply gCD; exists i.
 move=>[+ +][]/=[n][g][d][gC->][m][f][e] [fD->]=>_ _.
@@ -65,7 +66,7 @@ rewrite Convn_pair/comp/=; congr pair; apply S1_inj; rewrite !S1_Convn big_prod_
      apply eq_big=>// k; congr andb; rewrite 3!inE.
      by apply: (eqtype.inj_eq _ k (i, j)); exact: (can_inj (@unsplit_prodK _ _)).
   rewrite (big_pred1 (i, j))// fdist_prodE/= ssrR.mulRC; congr (scalept _ (S1 (g _))).
-  by move: (unsplit_prodK (i, j)) => /(congr1 fst)/esym.
+  by move: (unsplit_prodK (i, j)) => /(congr1 Datatypes.fst)/esym.
 rewrite (exchange_big_dep xpredT)//=; apply: eq_bigr => j _.
 rewrite -(scale1pt (scalept _ _)) scaleptA// -[(1 * e j)%coqR]/(1 * e j) -(FDist.f1 d).
 rewrite mulr_suml.
@@ -86,7 +87,7 @@ have -> : (\sum_(a in [finType of 'I_n * 'I_m] |
    apply: eq_big=>// k; congr andb; rewrite 3!inE.
    by apply: (eqtype.inj_eq _ k (i, j)); exact (can_inj (@unsplit_prodK _ _)).
 rewrite (big_pred1 (i, j))// fdist_prodE/=; congr (scalept _ (S1 (f _))).
-by move:(unsplit_prodK (i, j))=>/(congr1 snd)/esym.
+by move:(unsplit_prodK (i, j))=>/(congr1 Datatypes.snd)/esym.
 Qed.
 
 End convex.
@@ -146,6 +147,22 @@ by rewrite segmentC.
 Qed.
 
 End face.
+
+(* TODO: rm, will be fixed in infotheo 0.7.1 *)
+Module LinearAffine.
+Section linear_affine.
+Open Scope ring_scope.
+Variables (E F : lmodType R) (f : {linear E -> F}).
+Import LmoduleConvex.
+Let linear_is_affine: affine f.
+Proof. by move=>p x y; rewrite linearD 2!linearZZ. Qed.
+
+#[export] HB.instance Definition _ := isAffine.Build _ _ _ linear_is_affine.
+
+End linear_affine.
+End LinearAffine.
+HB.export LinearAffine.
+
 Section face.
 
 Variable E: lmodType R.
@@ -154,18 +171,17 @@ Local Open Scope fun_scope.
 Local Open Scope ring_scope.
 Local Open Scope convex_scope.
 
-Lemma probinvn1 : probinvn 1 = (2^-1)%R. R_numFieldType.
+Lemma probinvn1 : probinvn 1 = (1 / 2%R : R)%:pr.
 Proof.
-rewrite /R_numFieldType /GRing.inv /= /Rinvx.
-case:ifP=>// /negbFE.
-by rewrite/Rdefinitions.IZR intr_eq0.
+apply: val_inj => /=.
+by rewrite div1R.
 Qed.
 
-Lemma onem_half: onem 2^-1 = 2^-1.
+Lemma onem_half: onem 2^-1 = 2^-1 :> R.
 Proof.
-have ne20: (2 : R) != 0 by rewrite intr_eq0.
-apply (mulfI ne20).
-by rewrite mulrBr mulr1 divff// -pmulrn mulr2n -addrA subrr addr0.
+rewrite /onem.
+rewrite [X in X - _ = _](splitr 1).
+by rewrite div1r addrK.
 Qed.
 
 Lemma ext_carac (A : {convex_set E}) (x: E): x \in A -> [<-> x \in ext A;
@@ -174,8 +190,11 @@ Lemma ext_carac (A : {convex_set E}) (x: E): x \in A -> [<-> x \in ext A;
   face A [set x]].
 Proof.
 move=>xA.
-have ne20: (2 : R) != 0 by rewrite intr_eq0.
-have ge20: (0 : R) <= 2 by apply mulrz_ge0=>//; exact ler01.
+have ne20: (2 : R) != 0.
+  rewrite [X in X != _](_ : _ = 2%:R)//.
+  by rewrite pnatr_eq0.
+have ge20: (0 : R) <= 2.
+  by rewrite ler0n.
 split.
    move=>xext u v uA vA xe.
    move: xext=>/set_mem /(_ u v uA vA).
@@ -188,29 +207,32 @@ split.
       apply /esym; apply h=>//; last by left.
       rewrite xe convC; congr (v <| _ |> u).
       apply val_inj=>/=.
-      rewrite probinvn1 /onem.
-      by apply/eqP; rewrite subr_eq -(div1r 2) -splitr.
+      set tmp : R := (1 + 1)%:R.
+      rewrite (_ : tmp = 2%R)//.
+      rewrite coqRE.
+      by rewrite onem_half.
       move: xe=> -> + _.
       move=> /(congr1 (fun x => 2 *: x)).
-      rewrite scalerDr probinvn1 onem_half 2!scalerA divff// 2!scale1r.
-      by rewrite -pmulrn mulr2n scalerDl scale1r=>/addrI/esym.
+      rewrite scalerDr probinvn1/=.
+      rewrite div1R coqRE.
+      rewrite onem_half 2!scalerA divff// 2!scale1r.
+      by rewrite scaler_nat mulr2n =>/addrI/esym.
 split.
    move=>xext.
    apply/asboolP=>u v t [uA ux] [vA vx].
    split; first by move:(convex_setP A)=>/asboolP; apply.
-   wlog: u v t xext xA uA ux vA vx / (t : R) <= 2^-1.
+   wlog: u v t xext xA uA ux vA vx / Prob.p t <= 2^-1.
       move=>h.
-      have [tle|tle] := leP (t : R) (2^-1); first exact: (h u v t).
+      have [tle|tle] := leP (Prob.p t) (2^-1); first exact: (h u v t).
       rewrite convC.
       apply (h v u (onem t)%:pr)=>//.
       rewrite -onem_half; apply ler_sub=>//.
       exact/ltW.
    move=>tle.
-   have t01: ssrR.leRb (Rdefinitions.IZR BinNums.Z0) (2%:R*(t : R)) &&
-  ssrR.leRb (2*(t : R)) (Rdefinitions.IZR (BinNums.Zpos 1%AC)).
-      apply/andP; split; apply/ssrR.leRP/RleP.
-         apply mulr_ge0=>//.
-         by apply/RleP/prob_ge0.
+   have t01: ((Rdefinitions.IZR BinNums.Z0) <= 2%:R * (Prob.p t : R)) &&
+  (2*(Prob.p t : R) <= Rdefinitions.IZR (BinNums.Zpos 1%AC)).
+      apply/andP; split.
+        by apply mulr_ge0=>//.
       by move:tle=>/(ler_wpmul2l ge20); rewrite divff.
    move=>/esym xE.
    move: xext=>/(_ (u <| Prob.mk t01 |> v) v).
@@ -218,13 +240,11 @@ split.
    have ->: p_of_rs (Prob.mk t01) (probinvn 1) = t.
       apply val_inj.
       rewrite/= p_of_rsE/=.
-      have tE: (2*(t : R))/2 = t.
+      have tE: (2*(Prob.p t : R))/2 = Prob.p t.
          by rewrite mulrAC divff// mul1r.
       rewrite -{2}tE.
       congr Rdefinitions.RbaseSymbolsImpl.Rmult.
-      rewrite/R_unitRing/GRing.inv/=/Rinvx.
-      case:ifP=>//.
-      by rewrite ne20.
+      by rewrite coqRE//.
    have wA: u <| Prob.mk t01 |> v \in A.
       by apply mem_set; move:(convex_setP A)=>/asboolP; apply.
    move: vA=>/mem_set vA /(_ wA vA xE) /(congr1 (fun x => x-v)).
@@ -284,30 +304,29 @@ split; move=>[hex hface]; split=>//.
    wlog: f a hex hface / (forall x : E, x \in A -> f x <= a).
       move=>h; move: (hface); case=>hf.
          by apply (h f a).
-      move: h=>/(_ (GRing.comp_linear f (GRing.opp_linear E)) (- a)).
-      have hf' (x : E) : x \in A -> GRing.comp_linear f (GRing.opp_linear E) x <= - a.
+      move: h=>/(_ (f \o (@GRing.opp E)) (- a)).
+      have hf' (x : E) : x \in A -> (f \o (@GRing.opp E)) x <= - a.
         by move=> xA /=; rewrite -scaleN1r linearZZ scaleN1r ler_oppl opprK; apply hf.
-      have hex': exists x : E, x \in A /\ GRing.comp_linear f (GRing.opp_linear E) x = - a.
+      have hex': exists x : E, x \in A /\ (f \o (@GRing.opp E)) x = - a.
          by move: hex=>[x [xA fx]]; exists x; split=>//=; rewrite -fx -scaleN1r linearZZ scaleN1r.
       move=>/(_ hex' (or_introl hf') hf'); congr (face A (A `&` _)).
       by rewrite eqEsubset; split=>x /= /eqP; rewrite -scaleN1r linearZZ scaleN1r; [ rewrite eqr_opp | rewrite -eqr_opp ]=>/eqP.
    move=> hf; apply face'P; split; [ by apply subIsetl | |].
-      exact: (is_convex_setI _ (convex_set_of (is_convex_set_preimage _ (convex_set_of (is_convex_set1 (a : GRing.regular_lmodType R)))))).
+      exact: (is_convex_setI _ (convex_set_of (is_convex_set_preimage f (set1 a)))).
    move=> x u v /set_mem [xA xa] uA vA /set_mem [t _ tx] xv; apply mem_set; (split; [ by apply set_mem |]); apply /eqP; rewrite -lte_anti; apply /andP; (split; [ by apply hf |]).
-   have t0 : (t : R) != 0.
+   have t0 : (Prob.p t : R) != 0.
       by apply/eqP=>/val_inj t0; subst t; move: tx xv; rewrite conv0 => ->; rewrite eqxx.
-   have tgt : 0 < (t : R) by rewrite lt0r t0=>/=; exact/RleP.
-   move: tx=>/(f_equal (fun x=> (t : R)^-1 *: (x - (onem t) *: v))).
+   have tgt : 0 < (Prob.p t : R) by rewrite lt0r t0=>/=.
+   move: tx=>/(f_equal (fun x=> (Prob.p t : R)^-1 *: (x - (onem t) *: v))).
    rewrite -addrA subrr addr0 scalerA mulVf // scale1r=>->.
-   rewrite linearZZ linearD xa -scaleNr linearZZ ler_pdivl_mull// addrC -subr_ge0 -addrA -mulNr -{1}[a]mul1r -mulrDl scaleNr -scalerN -mulrDr; apply mulr_ge0.
-      exact/RleP.
+   rewrite linearZZ linearD xa -scaleNr linearZZ ler_pdivl_mull// addrC -subr_ge0 -addrA -mulNr -{1}[a]mul1r -mulrDl scaleNr -scalerN -mulrDr; apply mulr_ge0 => //.
    by rewrite addrC Num.Internals.subr_ge0; apply hf.
 have : forall x y, x \in A -> y \in A -> f x < a -> a < f y -> False.
    move=> u v uA vA fua afv.
    move: (Order.POrderTheory.lt_trans fua afv); rewrite -subr_gt0=>fufv.
-   have t01: ssrR.leRb (Rdefinitions.IZR BinNums.Z0) ((f v - a) / (f v - f u))%R &&
-  ssrR.leRb ((f v - a) / (f v - f u))%R (Rdefinitions.IZR (BinNums.Zpos 1%AC)).
-      apply/andP; split; apply/ssrR.leRP/RleP.
+   have t01: (Rdefinitions.IZR BinNums.Z0 <= (f v - a) / (f v - f u))%R &&
+  (((f v - a) / (f v - f u))%R <= Rdefinitions.IZR (BinNums.Zpos 1%AC)).
+      apply/andP; split.
          by apply divr_ge0; apply ltW=>//; rewrite subr_gt0.
          rewrite ler_pdivr_mulr// mul1r -subr_ge0 opprB addrAC addrCA subrr addr0 subr_ge0.
          by apply ltW.
@@ -318,7 +337,7 @@ have : forall x y, x \in A -> y \in A -> f x < a -> a < f y -> False.
       rewrite/= affine_conv/=/conv/=.
       move: fufv; rewrite lt0r=>/andP [fufv _].
       apply (mulfI fufv).
-      rewrite/GRing.regular_lmodType/GRing.scale/=.
+      rewrite/GRing.scale/=.
       rewrite mulrDr mulrAC mulrCA mulrAC divff// mulr1.
       rewrite [onem _ * _]mulrBl mul1r mulrBr mulrAC mulrCA mulrAC divff// mulr1.
       rewrite -mulrBl opprB addrAC addrCA subrr addr0.
@@ -361,21 +380,27 @@ Definition cone (x: E) (A: set E) := cone0 [set a - x | a in A]%classic.
 Lemma cone0_convex (A: set E): cone0 A ->
   (is_convex_set A <-> ([set a+b | a in A & b in A] `<=` A)%classic).
 Proof.
-have ne20: (2 : R) != 0 by rewrite intr_eq0.
-have /RltP/ssrR.ltRP gt20: (0 : R) < 2 by rewrite ltr0z.
+have ne20: (2 : R) != 0.
+  rewrite [X in X != _](_ : _ = 2%:R)//.
+  by rewrite pnatr_eq0.
+have gt20 : ((0 : R) < 2)%R.
+  by rewrite ltr0n.
 move=>Acone; split=>Aconv.
    move=>x [u uA] [v vA] <-.
    have uA2: A (2 *: u) by apply Acone; exists (Rpos.mk gt20)=>//; exists u.
    have vA2: A (2 *: v) by apply Acone; exists (Rpos.mk gt20)=>//; exists v.
    move:Aconv=>/asboolP/(_ _ _ (probinvn 1) uA2 vA2); congr A.
-   by rewrite/conv/= probinvn1 onem_half 2!scalerA mulrC divff// 2!scale1r.
+   rewrite probinvn1/=.
+   rewrite /conv/=.
+   rewrite div1R coqRE.
+   by rewrite onem_half 2!scalerA mulVf// 2!scale1r.
 apply/asboolP.
 move=>x y t xA yA.
-move:(prob_ge0 t)=>/RleP; rewrite le0r=>/orP; case.
+move:(prob_ge0 t); rewrite le0r=>/orP; case.
    by rewrite/conv/= =>/eqP ->; rewrite scale0r add0r onem0 scale1r.
-move=>/RltP/ssrR.ltRP t0; move: (prob_le1 t)=>/RleP; rewrite -subr_ge0 le0r=>/orP; case.
+move=> t0; move: (prob_le1 t); rewrite -subr_ge0 le0r=>/orP; case.
    by rewrite subr_eq0 /conv/= =>/eqP <-; rewrite onem1 scale0r addr0 scale1r.
-move=>/RltP/ssrR.ltRP t1; apply Aconv; exists ((t : R) *: x);
+move=> t1; apply Aconv; exists ((Prob.p t : R) *: x);
    [| exists ((onem t) *: y) ]=>//; apply Acone.
   by exists (Rpos.mk t0)=>//; exists x.
 by exists (Rpos.mk t1)=>//; exists y.
@@ -404,36 +429,37 @@ rewrite eqEsubset; split=>x.
       move=>/eqP /psumr_eq0P; move=> /(_ k0') /(_ ord0 Logic.eq_refl) k00; exfalso.
       by move:(Rpos_gt0 (k ord0))=>/RltP; rewrite k00 ltxx.
    move=>t0.
-   have tk0: forall i, Rdefinitions.Rle (Rdefinitions.IZR BinNums.Z0) ([ffun i => t^-1 * k i] i).
-      by move=>i; rewrite ffunE; apply/RleP/mulr_ge0; [ apply ltW; rewrite invr_gt0 | apply k0' ].
+   have tk0: forall i, (Rdefinitions.IZR BinNums.Z0 <= [ffun i => t^-1 * k i] i).
+      by move=>i; rewrite ffunE; apply/mulr_ge0; [ apply ltW; rewrite invr_gt0 | apply k0' ].
    have tk1 : \sum_(i < n.+1) [ffun i => t^-1 * k i] i = 1.
       transitivity (\sum_(i < n.+1) t^-1 * k i).
          by apply congr_big=>// i _; rewrite ffunE.
       rewrite -mulr_sumr mulrC divff//.
       by move:t0; rewrite lt0r=>/andP[].
-   move:(t0)=>/RltP/ssrR.ltRP t0'; exists (Rpos.mk t0')=>//; exists (t^-1 *: \sum_i (k i : R) *: s i).
-      exists n.+1, s, (@FDist.make _ (finfun (fun i=> t^-1 * k i)) tk0 tk1); split=> //.
+   move:(t0)=> t0'; exists (Rpos.mk t0')=>//; exists (t^-1 *: \sum_i (k i : R) *: s i).
+      exists n.+1, s, (@FDist.make _ _ (finfun (fun i=> t^-1 * k i)) tk0 tk1); split=> //.
       rewrite scaler_sumr avgnrE.
       apply congr_big=>// i _.
       by rewrite scalerA ffunE.
    by rewrite scalerA divff ?gt_eqF// scale1r.
 move=>[t /= _] [a [n [s [d [sA ->]]]]] <-.
-rewrite avgnrE scaler_sumr (@mathcomp_extra.bigID_idem _ _ _ _ _ _ _ _ (fun i=> 0 < d i)); [| apply addrA | apply addrC | apply addr0 ].
+rewrite avgnrE scaler_sumr.
+rewrite (@bigID_idem _ _ _ _ _ _ (fun i=> 0 < d i))/=; [| exact: addr0].
 have ->: \sum_(i | true && ~~ (0 < d i)) (t : R) *: (d i *: s i) = \sum_(i | true && ~~ (0 < d i)) 0 *: 0.
    apply congr_big=>// i /andP [_]; rewrite lt0r negb_and negbK.
-   move:(FDist.ge0 d i)=>/RleP->; rewrite orbF=>/eqP->.
+   move:(FDist.ge0 d i)=>->; rewrite orbF=>/eqP->.
    by rewrite 2!scale0r GRing.scaler0.
 rewrite -[\sum_(_ < _ | _) 0 *: 0]scaler_sumr scale0r addr0 -big_filter /=.
 remember [seq i <- index_enum [finType of 'I_n] | 0 < d i] as I; move: HeqI=>/esym HeqI.
 case: I HeqI=> [| i I] HeqI.
-   exfalso; move: (FDist.f1 d) (oner_neq0 R); rewrite (@mathcomp_extra.bigID_idem _ _ _ _ _ _ _ _ (fun i=> 0 < d i)); [| apply addrA | apply addrC | apply addr0 ].
+   exfalso; move: (FDist.f1 d) (oner_neq0 R); rewrite (@bigID_idem _ _ _ _ _ _ (fun i=> 0 < d i))/=; [|apply addr0 ].
    rewrite -big_filter HeqI big_nil/=.
-   have ->: forall x, Rdefinitions.RbaseSymbolsImpl.Rplus Rdefinitions.RbaseSymbolsImpl.R0 x = 0+x by [].
-   have ->: Rdefinitions.IZR (BinNums.Zpos 1%AC) = 1 by [].
    rewrite add0r=><- /eqP; apply.
    transitivity (\sum_(i < n | true && ~~ (0 < d i)) (0*0:R)).
       2: by rewrite -mulr_sumr mul0r.
-   by apply congr_big=>// i /= dile; move: (FDist.ge0 d i)=>/RleP; rewrite le0r mul0r=>/orP; case=> [ /eqP // | ]; move: dile=>/[swap]->.
+   apply congr_big=>// i /= dile; move: (FDist.ge0 d i); rewrite le0r.
+   rewrite (negbTE dile) orbF => /eqP ->.
+   by rewrite mul0R.
 have: subseq (i::I) (index_enum [finType of 'I_n]) by rewrite -HeqI; apply filter_subseq.
 case: n s d sA i I HeqI=> [| n] s d sA i I HeqI.
    by inversion i.
@@ -445,7 +471,7 @@ simple refine (ex_intro _ _ _).
    simple refine (Rpos.mk _).
       exact (d (nth ord0 (i :: I) j)).
    rewrite -HeqI.
-   apply/ssrR.ltRP/RltP/(@nth_filter _ (fun i=> 0 < d i)).
+   apply/(@nth_filter _ (fun i=> 0 < d i)).
    by rewrite HeqI.
 split.
    rewrite [in RHS]HeqI.
@@ -479,11 +505,11 @@ Local Open Scope ring_scope.
 Local Open Scope ereal_scope.
 Local Open Scope convex_scope.
 
-Definition fconvex := forall (x y: E) (t: prob),
-  f (x <|t|> y) <= EFin (t : R) * f x + EFin (onem t)%R * f y.
+Definition fconvex := forall (x y: E) (t: {prob R}),
+  f (x <|t|> y) <= EFin (Prob.p t : R) * f x + EFin (onem t)%R * f y.
 
-Definition fconvex_strict := forall (x y: E) (t: oprob), x <> y ->
-  f (x <|t|> y) < EFin (t : R) * f x + EFin (onem t)%R * f y.
+Definition fconvex_strict := forall (x y: E) (t: oprob R), x <> y ->
+  f (x <|t|> y) < EFin (Prob.p t : R) * f x + EFin (onem t)%R * f y.
 
 Lemma fconvex_max_ext (C: {convex_set E}) (x: E):
   fconvex_strict ->
@@ -494,16 +520,18 @@ Lemma fconvex_max_ext (C: {convex_set E}) (x: E):
 Proof.
 move=> fconv xC fxoo xmax.
 rewrite in_setE/ext/= =>u v /xmax uC /xmax vC /set_mem [t] _ xE; subst x.
-move: (prob_ge0 t)=>/RleP; rewrite le0r=>/orP; case.
+move: (prob_ge0 t); rewrite le0r=>/orP; case.
    by move=>/eqP/val_inj ->; right; rewrite conv0.
 move=>t0.
-move: (prob_le1 t)=>/RleP; rewrite -subr_ge0 le0r=>/orP; case.
-   have->: Rdefinitions.IZR (BinNums.Zpos 1%AC) = Prob.p (1%R)%:pr by [].
-   by rewrite subr_eq0=>/eqP/val_inj <-; left; rewrite conv1.
+move: (prob_le1 t); rewrite -subr_ge0 le0r=>/orP; case.
+  rewrite subr_eq0=>/eqP t1.
+  rewrite (_ : t = 1%:pr)//; last first.
+    by apply/val_inj.
+  by left; rewrite conv1.
 rewrite subr_gt0=>t1.
-have t01: ssrR.ltRb (Rdefinitions.IZR BinNums.Z0) t &&
-       ssrR.ltRb t (Rdefinitions.IZR (BinNums.Zpos 1%AC)).
-   by apply/andP; split; apply/ssrR.ltRP/RltP.
+have t01: (Rdefinitions.IZR BinNums.Z0 < Prob.p t)%R &&
+       (Prob.p t < Rdefinitions.IZR (BinNums.Zpos 1%AC))%R.
+   by apply/andP; split.
 have [->|/eqP uv] := eqVneq u v; first by rewrite convmm; left.
 move:(fconv u v (OProb.mk t01) uv)=>/=.
 have fle: (Prob.p t)%:E * f u + (onem (Prob.p t))%:E * f v <= f (u <|t|> v).
@@ -511,8 +539,8 @@ have fle: (Prob.p t)%:E * f u + (onem (Prob.p t))%:E * f v <= f (u <|t|> v).
       rewrite -ge0_muleDl ?lee_fin /onem ?RminusE -?EFinD.
       - by rewrite addrCA subrr addr0 mul1e.
       - by apply ltW.
-      - by rewrite subr_ge0; apply/RleP/prob_le1.
-   apply (@lee_add R_realDomainType); rewrite (@lee_pmul2l R_realDomainType)//= lte_fin.
+      - by rewrite subr_ge0; apply/prob_le1.
+   apply (@lee_add R); rewrite (@lee_pmul2l R)//= lte_fin.
    by rewrite subr_gt0.
 by move=>/(Order.POrderTheory.le_lt_trans fle); rewrite ltxx.
 Qed.
diff --git a/theories/desc.v b/theories/desc.v
index af0a51e..4a6c462 100644
--- a/theories/desc.v
+++ b/theories/desc.v
@@ -836,7 +836,7 @@ Lemma desc_l4 (p: {poly R}) :  alternate_1 p -> inv2 p.
 Proof.
 move: p;elim/poly_ind => [| p a ih]; first by rewrite/alternate_1 polyseq0.
 have desc_c: alternate_1 (a%:P) -> inv2 (a%:P).
-  rewrite polyseqC;case (a==0) => //=; case ha: (0< a) => // _.
+  rewrite polyseqC;case: (a==0) => //=; case ha: (0< a) => // _.
   move=> eps eps0; exists (eps / a); split.
       by move => y _ _; rewrite !hornerC.
     by move => y1 y2 _ _ _ ; rewrite !hornerC.
diff --git a/theories/desc1.v b/theories/desc1.v
index 8458ce5..f1724f0 100644
--- a/theories/desc1.v
+++ b/theories/desc1.v
@@ -174,7 +174,7 @@ have dnz: d != 0 by move: etc; rewrite /d; case s => // s' l' /= /andP [].
 rewrite addnC addnA addnC; move: (hr etc).
 rewrite -sgr_gt0 - (sgr_gt0 (c*b)) - sgr_lt0 ! sgrM.
 rewrite /sgr - if_neg   - (if_neg (c==0))- (if_neg (b==0)) bnz dnz cnz.
-by case (d<0); case (b<0); case (c<0); rewrite ?mulrNN ? mulr1 ?mul1r ?ltr01
+by case: (d<0); case: (b<0); case: (c<0); rewrite ?mulrNN ? mulr1 ?mul1r ?ltr01
     ?ltrN10 ? ltr10 ? ltr0N1 ?addn0 ? addnS ?addn0//=; move => ->.
 Qed.
 
@@ -594,7 +594,9 @@ have q2: all (root q) l.
 have [r qv rq]:= (Hrec q  q0  q1 ul q2).
 exists r => //; rewrite {1} pv {1} qv mulrAC; congr (_ * _).
 rewrite big_cons mulrC; congr (_ * _).
-rewrite 2! (big_nth 0) 2! big_mkord; apply: eq_bigr => i _.
+rewrite (big_nth 0).
+rewrite [in RHS](big_nth 0).
+rewrite 2!big_mkord; apply: eq_bigr => i _.
 set b := l`_i;congr (_ ^+ _).
 have rb: root q b by apply /(allP q2); rewrite mem_nth //.
 have nr: ~~ root (('X - a%:P) ^+ \mu_a p) b.
diff --git a/theories/pol.v b/theories/pol.v
index 77adcfa..0bb7f36 100644
--- a/theories/pol.v
+++ b/theories/pol.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect.
 From mathcomp Require Import ssralg poly ssrnum ssrint rat polyrcf.
 From mathcomp Require Import polyorder polydiv.
@@ -73,7 +74,7 @@ Qed.
 
 Lemma double_half x : half x + half x = x.
 Proof.
-by rewrite -mulrDl-mulr2n - mulr_natr -mulrA divrr ?two_unit ?mulr1.
+by rewrite /half -splitr.
 Qed.
 
 Lemma half_inj (x y : R) : half x = half y -> x = y.
@@ -443,10 +444,11 @@ Proof.
 split. move=> x y; exact: comp_polyM. by rewrite /shift_poly comp_polyC.
 Qed.
 
+(*HB.instance Definition _ c := GRing.isLinear.Build _ _ _ _ _ (shift_poly_is_linear c).
+
 Canonical shift_poly_additive c := Additive (shift_poly_is_linear c).
 Canonical shift_poly_linear c := Linear (shift_poly_is_linear c).
-Canonical shift_poly_rmorphism c := AddRMorphism (shift_poly_multiplicative c).
-
+Canonical shift_poly_rmorphism c := AddRMorphism (shift_poly_multiplicative c).*)
 
 Lemma shift_polyD  c1 c2 p:
   p \shift (c2 + c1) = (p\shift c1) \shift c2.
@@ -650,7 +652,7 @@ Qed.
 Lemma reciprocalM p q :
   reciprocal_pol (p * q) = reciprocal_pol p * reciprocal_pol q.
 Proof.
-move: (reciprocalC (GRing.zero R)) => aux.
+move: (reciprocalC 0) => aux.
 case (poly0Vpos p); first by move => ->; rewrite mul0r aux mul0r.
 case (poly0Vpos q); first by move => -> _; rewrite mulr0 aux mulr0.
 set m:=  (size p + size q).-1; move=> pa pb.
@@ -727,7 +729,7 @@ Proof.
 move=> Hp.
 have H0noroot : ~~(root (p %/ 'X^(\mu_0 p)) 0).
   rewrite -mu_gt0.
-    rewrite -eqn0Ngt -(addr0 'X) -(@oppr0 (poly_zmodType R)) -polyC0 mu_div
+    rewrite -eqn0Ngt -(addr0 'X) -(@oppr0 {poly R}) -polyC0 mu_div
       ?subn_eq0; by rewrite leqnn.
   rewrite Pdiv.CommonIdomain.divp_eq0 negb_or Hp /= negb_or.
   rewrite -size_poly_gt0 {1}size_polyXn /= -leqNgt dvdp_leq //.
@@ -1145,7 +1147,8 @@ have : `|p.[b'] - p.[a']| <= eps.
     rewrite mulrA ler_pdivr_mulr ?ltr0Sn // mulrC [eps * _]mulrC.
     rewrite -ler_pdivr_mulr //; apply: (ltW  qn).
 case/ler_normlP => h1 h2.
-rewrite ler_oppl -(ler_add2l p.[b']) (le_trans h2) ? ler_addr //.
+rewrite ler_oppl/= !andbT.
+rewrite -[in X in X && _](ler_add2l p.[b']) (le_trans h2) ? ler_addr //.
 by rewrite -(ler_add2r (- p.[a'])) (le_trans h2) // ler_addl oppr_gte0 ltW.
 Qed.
 
diff --git a/theories/preliminaries.v b/theories/preliminaries.v
index 718d00d..8d3c3a4 100644
--- a/theories/preliminaries.v
+++ b/theories/preliminaries.v
@@ -230,7 +230,7 @@ From infotheo Require Import fdist.
 Local Open Scope fdist_scope.
 
 Lemma Convn_pair [T U : convType] [n : nat] (g : 'I_n -> T * U) (d : {fdist 'I_n}) :
-  Convn d g = (Convn d (fst \o g), Convn d (snd \o g)).
+  Convn conv d g = (Convn conv d (Datatypes.fst \o g), Convn conv d (Datatypes.snd \o g)).
 Proof.
 elim: n g d => [|n IHn] g d.
    by have := fdistI0_False d.

From ded56af44b64588382a1892d080d8b9c6307cb22 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Mon, 22 Apr 2024 17:03:57 +0900
Subject: [PATCH 04/43] compile with infotheo 0.7.0

---
 _CoqProject | 1 -
 1 file changed, 1 deletion(-)

diff --git a/_CoqProject b/_CoqProject
index 776c18d..2e74d0f 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -24,7 +24,6 @@ theories/axiomsKnuth.v
 theories/preliminaries_hull.v
 
 -R theories trajectories
--R ../infotheo infotheo 
 
 -arg -w -arg -notation-overridden
 -arg -w -arg -ambiguous-paths

From 815334d8703db9ce10d5392538f19c19862dc3db Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Mon, 22 Apr 2024 17:17:50 +0900
Subject: [PATCH 05/43] fix

---
 theories/poly_normal.v | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/theories/poly_normal.v b/theories/poly_normal.v
index 2ca3ff0..82ca788 100644
--- a/theories/poly_normal.v
+++ b/theories/poly_normal.v
@@ -183,7 +183,7 @@ rewrite exprMn_comm; last first.
   by rewrite -mulNrn mulrC.
 rewrite sqrrN.
 rewrite -natrX.
-rewrite mulr_natl.
+rewrite (mulr_natl _ (2 ^ 2)).
 rewrite [_ ^+2 *+ _]mulrS ler_add2l -mulr_natl -andbA /=.
 apply/idP/idP => [/orP [] | H].
     rewrite eq_sym paddr_eq0 ?sqr_ge0 //.

From 65c5b13dcfc245a827cc54327cb5435d48d42952 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Mon, 22 Apr 2024 20:34:15 +0900
Subject: [PATCH 06/43] progress

---
 theories/casteljau.v   | 12 ++++++----
 theories/desc.v        |  2 +-
 theories/desc2.v       |  6 +++--
 theories/infra.v       | 52 ++++++++++++++----------------------------
 theories/poly_normal.v | 42 +++++++++++++++++-----------------
 5 files changed, 51 insertions(+), 63 deletions(-)

diff --git a/theories/casteljau.v b/theories/casteljau.v
index 5016c64..bed17c7 100644
--- a/theories/casteljau.v
+++ b/theories/casteljau.v
@@ -724,7 +724,7 @@ have -> // : forall c : R, c != 0 ->
   move=> c hc; rewrite scaleX_polyE size_factor_expr.
   rewrite [(_ * _ + _) ^+ _]exprDn.
   rewrite (reindex_inj rev_ord_inj) /=.
-  rewrite power_monom poly_def; apply: eq_bigr => j _.
+  rewrite power_monom [LHS]poly_def; apply: eq_bigr => j _.
   rewrite coef_poly subSS; have -> : (j < i.+1)%N by case j.
   rewrite subKn; last by case j.
   rewrite exprMn_comm; last by exact: mulrC.
@@ -753,7 +753,7 @@ Qed.
 
 Lemma scaleD (p q : {poly R}) u : (p + q) \shift u = p \shift u + (q \shift u).
 Proof.
-by rewrite /scaleX_poly linearD.
+by apply: linearD.
 Qed.
 
 (* TODO : move to another section and abstract over deg a b, maybe *)
@@ -894,11 +894,15 @@ rewrite [_ \shift 0]/shift_poly addr0 comp_polyXr.
   and lemma about composing scale operations. *)
 rewrite recip_scale_swap // recipK // /sc mul_polyC /scaleX_poly linearZ /=.
 rewrite -comp_polyA comp_polyM comp_polyX comp_polyC -mulrA -polyCM.
-by rewrite mulVf // mulr1 comp_polyXr linearZ /= shift_polyDK.
+rewrite mulVf // mulr1 comp_polyXr.
+transitivity ((b - a) ^+ deg *: ((q \shift a) \shift - a)).
+  exact: linearZ.
+by rewrite /= shift_polyDK.
 Qed.
 
 Lemma relocate0 (p : {poly R}) : (size p <= deg.+1)%N ->
   (relocate p == 0) = (p == 0).
+Proof.
 move=> s; apply/idP/idP; last first.
   move/eqP=> ->; rewrite /relocate /shift_poly /scaleX_poly !linear0.
   by rewrite size_poly0 ltn0 recip0 linear0.
@@ -1048,7 +1052,7 @@ have -> : bernp a b p k =
 have -> : (('X - a%:P) ^+ k * ((b - a) ^- k)%:P) =
            (beta^+k)%:P * (('X - a%:P) ^+ k * ((m - a) ^- k)%:P).
   rewrite /beta expr_div_n polyCM !mulrA -[_ * (_ ^+k)]mulrC !mulrA mulrAC.
-  rewrite -!mulrA -polyCM mulfV ?polyC1 ?mulr1 ?expf_eq0 ?subr_eq0 //.
+  rewrite -!mulrA -polyCM. mulfV. ?polyC1 ?mulr1 ?expf_eq0 ?subr_eq0 //.
   by move/negPf: dma => ->; rewrite andbF.
 rewrite -(exprVn (b - a)) [(_ ^-1 ^+ _)%:P]polyC_exp.
 rewrite -exprMn_comm; last by exact: mulrC.
diff --git a/theories/desc.v b/theories/desc.v
index 4a6c462..8c90999 100644
--- a/theories/desc.v
+++ b/theories/desc.v
@@ -1086,7 +1086,7 @@ move: (pol_lip q (z:=y)); set c := (norm_pol q^`()).[y] => cp.
 have cp0 : 0 < c.
   move: (lt_le_trans nega posb'); rewrite - subr_gt0 => dp.
   move: (ltW (le_lt_trans b'y' y'y)) => pb.
-  move: y0; rewrite -oppr_lt0 => yn0.
+  move: y0; rewrite -(oppr_lt0 y) => yn0.
   move: (ltW (lt_trans yn0 (lt_le_trans x10 x1a))) => pa.
   move: (cp _ _ pa (ltW ab) pb); rewrite (gtr0_norm dp) => dp'.
   by move: (lt_le_trans  dp dp'); rewrite pmulr_lgt0 // subr_gt0.
diff --git a/theories/desc2.v b/theories/desc2.v
index e621a0e..0dc145e 100644
--- a/theories/desc2.v
+++ b/theories/desc2.v
@@ -197,7 +197,7 @@ have dnz: d != 0 by move: etc; rewrite /d; case s => // s' l' /= /andP [].
 rewrite addnC addnA addnC; move: (hr etc).
 rewrite -sgr_gt0 - (sgr_gt0 (c*b)) - sgr_lt0 ! sgrM.
 rewrite /sgr - if_neg   - (if_neg (c==0))- (if_neg (b==0)) bnz dnz cnz.
-by case (d<0); case (b<0); case (c<0); rewrite ?mulrNN ? mulr1 ?mul1r ?ltr01
+by case: (d<0); case: (b<0); case: (c<0); rewrite ?mulrNN ? mulr1 ?mul1r ?ltr01
     ?ltrN10 ? ltr10 ? ltr0N1 ?addn0 ? addnS ?addn0//=; move => ->.
 Qed.
 
@@ -282,7 +282,9 @@ have q2: all (root q) l.
 have [r qv rq]:= (Hrec q  q0  q1 ul q2).
 exists r => //; rewrite {1} pv {1} qv mulrAC; congr (_ * _).
 rewrite big_cons mulrC; congr (_ * _).
-rewrite 2! (big_nth 0) 2! big_mkord; apply: eq_bigr => i _.
+rewrite (big_nth 0).
+rewrite [RHS](big_nth 0).
+rewrite 2! big_mkord; apply: eq_bigr => i _.
 set b := l`_i;congr (_ ^+ _).
 have rb: root q b by apply /(allP q2); rewrite mem_nth //.
 have nr: ~~ root (('X - a%:P) ^+ \mu_a p) b.
diff --git a/theories/infra.v b/theories/infra.v
index 125f04f..710e47a 100644
--- a/theories/infra.v
+++ b/theories/infra.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq order.
 From mathcomp Require Import choice fintype finfun ssrfun bigop ssralg.
 (*Require Import orderedalg.*)
@@ -34,8 +35,7 @@ Proof.
   rewrite /eqp; case e: ((p ?= q))%positive=> // _; exact: Pcompare_Eq_eq.
 Qed.
 
-Canonical Structure eqp_Mixin := EqMixin eqpP.
-Canonical Structure eqp_eqType := Eval hnf in EqType positive eqp_Mixin.
+HB.instance Definition _ := hasDecEq.Build _ eqpP.
 
 Definition p_unpickle n := Some (Pos.pred (P_of_succ_nat n)).
 
@@ -45,22 +45,19 @@ Proof.
   by rewrite pred_o_P_of_succ_nat_o_nat_of_P_eq_id.
 Qed.
 
-Definition p_countMixin  := CountMixin p_pick_cancel.
-Definition p_choiceMixin := CountChoiceMixin p_countMixin.
+HB.instance Definition _ := @PCanIsCountable _ _ _ _ p_pick_cancel.
 
-Canonical Structure p_choiceType :=
+(*Canonical Structure p_choiceType :=
   Eval hnf in ChoiceType positive p_choiceMixin.
 Canonical Structure p_countType :=
-  Eval hnf in CountType positive p_countMixin.
+  Eval hnf in CountType positive p_countMixin.*)
 
 (* Structures on Z *)
 
 Lemma eqzP : Equality.axiom Zeq_bool.
 Proof. by move=> z1 z2;  apply: (iffP idP); move/Zeq_is_eq_bool. Qed.
 
-Canonical Structure Z_Mixin := EqMixin eqzP.
-Canonical Structure Z_eqType := Eval hnf in EqType Z Z_Mixin.
-
+HB.instance Definition _ := hasDecEq.Build _ eqzP.
 
 Definition z_code (z : Z) :=
   match z with
@@ -99,6 +96,9 @@ Proof.
   by move=> x; rewrite /z_pickle /z_unpickle pickleK z_codeK.
 Qed.
 
+HB.instance Definition _ := @PCanIsCountable _ _ _ _ z_pick_cancel.
+
+(*
 Definition z_countMixin  := CountMixin z_pick_cancel.
 Definition z_choiceMixin := CountChoiceMixin z_countMixin.
 
@@ -106,7 +106,7 @@ Canonical Structure z_choiceType :=
   Eval hnf in ChoiceType Z z_choiceMixin.
 Canonical Structure z_countType :=
   Eval hnf in CountType Z z_countMixin.
-
+*)
 
 Lemma ZplusA : associative Zplus.
 Proof. by exact Zplus_assoc. Qed.
@@ -123,11 +123,7 @@ Proof. exact Zplus_opp_l. Qed.
 Lemma ZplusrN : right_inverse 0%Z Z.opp Zplus.
 Proof. exact Zplus_opp_r. Qed.
 
-Definition Z_zmodMixin :=
-  ZmodMixin ZplusA ZplusC Zplus0 ZplusNr.
-
-Canonical Structure Z_zmodType :=
-  Eval hnf in ZmodType Z Z_zmodMixin.
+HB.instance Definition _ := @GRing.isZmodule.Build Z _ _ _ ZplusA ZplusC Zplus0 ZplusNr.
 
 (* Z Ring *)
 Lemma ZmultA : associative Zmult.
@@ -151,16 +147,12 @@ Proof. exact: Zmult_plus_distr_r. Qed.
 Lemma nonzeroZ1 : 1%Z != 0%Z.
 Proof. by []. Qed.
 
-Definition Z_ringMixin :=
-  RingMixin ZmultA Zmult1q Zmultq1 Zmult_addl Zmult_addr nonzeroZ1.
-
-Canonical Structure Z_ringType :=
-  Eval hnf in RingType Z Z_ringMixin.
+HB.instance Definition _ := @GRing.Zmodule_isRing.Build Z _ _ ZmultA Zmult1q Zmultq1 Zmult_addl Zmult_addr nonzeroZ1.
 
 Lemma ZmultC : commutative Zmult.
 Proof. exact: Zmult_comm. Qed.
 
-Canonical Structure Z_comRingType := ComRingType Z ZmultC.
+HB.instance Definition _ := @GRing.Ring_hasCommutativeMul.Build Z ZmultC.
 
 (* Warning : an antisymmetric an a transitive predicates are
 present in loaded Relations.Relation_Definition *)
@@ -202,12 +194,7 @@ Qed.
 Lemma  Zinv_out : {in predC Zunit, Zinv =1 id}.
 Proof. exact. Qed.
 
-Definition Z_comUnitRingMixin :=  ComUnitRingMixin ZmulV unitZPl Zinv_out.
-
-Canonical Structure Z_unitRingType :=
-  Eval hnf in UnitRingType Z Z_comUnitRingMixin.
-
-Canonical Structure Z_comUnitRing := Eval hnf in [comUnitRingType of Z].
+HB.instance Definition _ := GRing.ComRing_hasMulInverse.Build Z ZmulV unitZPl Zinv_out.
 
 Lemma Z_idomain_axiom : forall x y : Z,
   x * y = 0 -> (x == 0) || (y == 0).
@@ -216,7 +203,7 @@ move=> x y; rewrite -[x * y]/(Zmult x y); move/Zmult_integral; case=> -> //=.
 by rewrite eqxx orbT.
 Qed.
 
-Canonical Structure Z_iDomain := Eval hnf in IdomainType Z Z_idomain_axiom.
+HB.instance Definition _ := @GRing.ComUnitRing_isIntegral.Build Z Z_idomain_axiom.
 
 Lemma Zlt_def (x y : Z) : (x <? y)%Z = (y != x) && (x <=? y)%Z.
 Proof.
@@ -236,13 +223,8 @@ Lemma Z_display : Datatypes.unit. Proof. exact: tt. Qed.
   @LePOrderMixin Z_eqType Z.leb Z.ltb Zlt_def Zle_bool_refl Zle_bool_antisymb Zle_bool_transb.
 Canonical Z_porderType := POrderType Z_display Z Z_OrderedRingMixin.*)
 
-Definition Z_OrderedRingMixin2 :=
-  LeOrderMixin Zlt_def (fun _ _ => erefl) (fun _ _ => erefl) Zle_bool_antisymb Zle_bool_transb Zle_total.
-
-Canonical z_porderType := POrderType Z_display Z Z_OrderedRingMixin2.
-Canonical z_latticeType := LatticeType Z Z_OrderedRingMixin2.
-Canonical z_distrLatticeType := DistrLatticeType Z Z_OrderedRingMixin2.
-Canonical z_orderType := OrderType Z Z_OrderedRingMixin2.
+HB.instance Definition _ :=
+  @Order.isOrder.Build Z_display Z _ _ _ _ Zlt_def (fun _ _ => erefl) (fun _ _ => erefl) Zle_bool_antisymb Zle_bool_transb Zle_total.
 
 (*Canonical Structure Z_OrderedRingType :=
   Eval hnf in OIdomainType Z Z_OrderedRingMixin.
diff --git a/theories/poly_normal.v b/theories/poly_normal.v
index 82ca788..102b62b 100644
--- a/theories/poly_normal.v
+++ b/theories/poly_normal.v
@@ -402,7 +402,7 @@ rewrite (big_cat_nat op (n:=n)) // big_nat1 Hn
   [x in (op _ _ = x)](big_cat_nat op (n:=n)) // big_nat1 big_nat1
   (Monoid.mulmA op).
 congr (op _ _).
-rewrite -big_split big_nat [x in (_ = x)]big_nat.
+rewrite -[LHS]big_split big_nat [x in (_ = x)]big_nat.
 apply: eq_bigr => i Hi.
 rewrite [x in (_ = x)](big_cat_nat op (n:=n)) // ?big_nat1 // ltnW//.
 by case/andP: Hi=> _ ->.
@@ -531,9 +531,9 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
       \sum_(h.+2 <= j < k.+2) p`_h * q`_(k.-1 - h) * (p`_j * q`_(k.+1 - j)).
     rewrite big_add1 -pred_Sn -!big_split big_nat [x in (_ = x)]big_nat.
     apply: eq_bigr => h Hh.
-    rewrite (big_cat_nat (n:= h.+1) (GRing.add_comoid R) (fun j => true)
+    rewrite (big_cat_nat (n:= h.+1) GRing.add (fun j => true)
       (fun j => p`_h * q`_(k.-1 - h) * (p`_j * q`_(k.+1 - j))) ) //.
-      rewrite (big_cat_nat (n:= h.+2) (m:=h.+1) (GRing.add_comoid R)
+      rewrite (big_cat_nat (n:= h.+2) (m:=h.+1) GRing.add
         (fun j => true)
         (fun j => p`_h * q`_(k.-1 - h) * (p`_j * q`_(k.+1 - j))) ).
           rewrite big_nat1 -pred_Sn /= -/(nth 0 _ (h.+1)) !addrA.
@@ -547,8 +547,8 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
   rewrite H {H}
   [x in ((x + _) - _)]addrC -[x in (_ - x)]addrA [x in (_ - (_ + x))]addrC
   !opprD !addrA addrC -sumrN !addrA -big_split.
-  have H : \big[GRing.add_comoid R/0]_(1 <= i < k.+1)
-      (GRing.add_comoid R)
+  have H : \big[GRing.add/0]_(1 <= i < k.+1)
+      GRing.add
         (- (p`_i.-1 * q`_(k - i) * (p`_i * q`_(k.+1 - i))))
         (p`_i * q`_(k - i) * (p`_i.-1 * q`_(k - i.-1))) = 0.
     rewrite big_split sumrN /= addrC.
@@ -586,8 +586,8 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
       by rewrite big_add1 -pred_Sn.
     rewrite H {H} [x in (_ + (_ + _) - x - _)]xchange
       -{12}(prednK Hk) [x in (_ + (_ + _) - x - _)]big_nat_recl//.
-    have H :(\big[GRing.add_comoid R/0]_(0 <= i < k.-1)
-         \big[GRing.add_comoid R/0]_(i.+1 <= j < k)
+    have H :(\big[GRing.add/0]_(0 <= i < k.-1)
+         \big[GRing.add/0]_(i.+1 <= j < k)
             (p`_j * q`_(k.-1 - j) * (p`_i.+1 * q`_(k.+1 - i.+1))) =
          \sum_(1 <= h < k)
       \sum_(h <= j < k) p`_h * q`_(k.+1 - h) * (p`_j * q`_(k.-1 - j))).
@@ -602,14 +602,14 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
       \sum_(1 <= h < k)
         \sum_(h <= j < k) p`_h.-1 * q`_(k - h) * (p`_j.+1 * q`_(k - j)) +
       \sum_(1 <= i < k.+1) p`_i.-1 * q`_(k - i) * (p`_k.+1 * q`_0).
-      rewrite (big_cat_nat (GRing.add_comoid R) (n:= k)) //
+      rewrite (big_cat_nat GRing.add (n:= k)) //
         big_nat1 big_nat1
-        [x in (_ = _ + x)](big_cat_nat (GRing.add_comoid R) (n:= k)) //
+        [x in (_ = _ + x)](big_cat_nat GRing.add (n:= k)) //
         big_nat1 (addnK k 0%N) Monoid.addmA.
       congr (_ + _).
       rewrite -big_split big_nat [x in (_ = x)]big_nat.
       apply: eq_bigr => i Hi.
-      rewrite  (big_cat_nat (GRing.add_comoid R) (n:= k)) //.
+      rewrite  (big_cat_nat GRing.add (n:= k)) //.
         rewrite big_nat1.
         by rewrite (addnK k 0%N).
       apply: ltnW.
@@ -620,14 +620,14 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
        \sum_(1 <= h < k)
          \sum_(h <= j < k) p`_h * q`_(k - h) * (p`_j * q`_(k - j)) +
        \sum_(1 <= i < k.+1) p`_i * q`_(k - i) * (p`_k * q`_0).
-      rewrite (big_cat_nat (GRing.add_comoid R) (n:= k)) //
+      rewrite (big_cat_nat GRing.add (n:= k)) //
         big_nat1 big_nat1
-        [x in (_ = _ + x)](big_cat_nat (GRing.add_comoid R) (n:= k)) //
+        [x in (_ = _ + x)](big_cat_nat GRing.add (n:= k)) //
         big_nat1 (addnK k 0%N) Monoid.addmA.
       congr (_ + _).
       rewrite -big_split big_nat [x in (_ = x)]big_nat.
       apply: eq_bigr => i Hi.
-      rewrite  (big_cat_nat (GRing.add_comoid R) (n:= k)) //.
+      rewrite  (big_cat_nat GRing.add (n:= k)) //.
         by rewrite big_nat1 (addnK k 0%N).
       apply: ltnW.
       by case/andP : Hi.
@@ -637,15 +637,15 @@ apply/normalP; split=> [k | |k Hk |i Hpqi j Hij Hj].
       [x in (((((_ + x) + _) + _) + _) + _)]addrC
       !addrA -big_split
       -addrA [x in (_ + x)]addrC !addrA addrC !addrA -big_split.
-    have H : \big[GRing.add_comoid R/0]_(1 <= i < k)
-      (GRing.add_comoid R)
-        ((GRing.add_comoid R)
+    have H : \big[GRing.add/0]_(1 <= i < k)
+      GRing.add
+        (GRing.add
            (-
             (\sum_(i <= j < k) p`_i * q`_(k.+1 - i) * (p`_j * q`_(k.-1 - j))))
            (-
             (\sum_(i <= j < k) p`_i.-1 * q`_(k - i) * (p`_j.+1 * q`_(k - j)))))
-        ((GRing.add_comoid R)
-           (\big[GRing.add_comoid R/0]_(i <= j < k)
+        (GRing.add
+           (\big[GRing.add/0]_(i <= j < k)
                (p`_j.+1 * q`_(k - j.+1) * (p`_i.-1 * q`_(k - i.-1))))
            (\sum_(i <= j < k) p`_i * q`_(k - i) * (p`_j * q`_(k - j)))) =
         \sum_(1 <= h < k) \sum_(h <= j < k) (p`_h * p`_j - p`_h.-1 * p`_j.+1) *
@@ -848,8 +848,8 @@ Proof.
 move=> p z Hz Hrootz.
 have Hrootzbar : root (toC p) z^*.
   by rewrite -complex_root_conj_polyR.
-have Hp := (factor_complex_roots z).
-rewrite -(dvdp_map ((ComplexField.real_complex_rmorphism R))) /= Hp.
+have /= Hp := (factor_complex_roots z).
+rewrite -(dvdp_map (real_complex R)) /= Hp.
 rewrite Gauss_dvdp.
   apply/andP; split; by rewrite -root_factor_theorem.
 apply: Pdiv.ClosedField.root_coprimep => x.
@@ -868,7 +868,7 @@ Lemma real_root_div_poly_deg1 (p : {poly R}) (z : C) :
 Proof.
 move=>Himz Hroot.
 rewrite root_factor_theorem (@complexE _ z) Himz mulr0 addr0 in Hroot.
-rewrite -(dvdp_map ((ComplexField.real_complex_rmorphism R))) /=.
+rewrite -(dvdp_map (real_complex R)) /=.
 have H : toC ('X - (Re z)%:P) = 'X - ((Re z)%:C)%:P.
   by rewrite map_poly_is_additive map_polyC map_polyX.
 by rewrite H.

From 6da993856c9dd29891782bd25140e63d1e89a46f Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Tue, 23 Apr 2024 11:16:26 +0900
Subject: [PATCH 07/43] complete port?

---
 theories/axiomsKnuth.v        |  2 +-
 theories/bern.v               |  2 +-
 theories/casteljau.v          |  8 ++++----
 theories/conv.v               | 22 +++++++++++++++-------
 theories/counterclockwise.v   | 14 +++++++++-----
 theories/encompass.v          |  2 +-
 theories/hulls.v              | 10 +++++-----
 theories/intersection.v       | 14 +++++++-------
 theories/isolate.v            |  9 +++++----
 theories/pol.v                |  6 +++++-
 theories/preliminaries_hull.v |  7 +++++--
 theories/three_circles.v      | 15 ++++++++-------
 12 files changed, 66 insertions(+), 45 deletions(-)

diff --git a/theories/axiomsKnuth.v b/theories/axiomsKnuth.v
index 7937f36..6812757 100644
--- a/theories/axiomsKnuth.v
+++ b/theories/axiomsKnuth.v
@@ -7,7 +7,7 @@ Module Type KnuthAxioms.
 Section Dummy.
 
 Variable R : realType.
-Definition Plane := pair_vectType (regular_vectType R) (regular_vectType R).
+Definition Plane : vectType _ := (R^o * R^o)%type.
 Parameter OT : Plane -> Plane -> Plane -> bool.
 
 (*Knuth's axioms are given by the following variables.  But axiom 4 is not used in Jarvis' algorithm and axiom 3 is a property of the data, not of the
diff --git a/theories/bern.v b/theories/bern.v
index a71af14..4223c62 100644
--- a/theories/bern.v
+++ b/theories/bern.v
@@ -135,7 +135,7 @@ have p1 : (0 < eps / 2%:R)%R by rewrite divr_gt0// ltr0n.
 have cmp : eps / 2%:R < eps.
    by rewrite ltr_pdivr_mulr// ?ltr0n// ltr_pmulr// ltr1n.
 split => //.
-by rewrite -mulrDr ger_pmulr// -mulr2n -mulr_natr mulVf// pnatr_eq0.
+by rewrite -splitr.
 Qed.
 
 Lemma ler_horner_norm_pol {R : realFieldType} (l : {poly R}) x :
diff --git a/theories/casteljau.v b/theories/casteljau.v
index bed17c7..8884ba5 100644
--- a/theories/casteljau.v
+++ b/theories/casteljau.v
@@ -1051,8 +1051,8 @@ have -> : bernp a b p k =
   by rewrite -invfM -exprD subnKC // !mulrA [_ %:P * _]mulrC.
 have -> : (('X - a%:P) ^+ k * ((b - a) ^- k)%:P) =
            (beta^+k)%:P * (('X - a%:P) ^+ k * ((m - a) ^- k)%:P).
-  rewrite /beta expr_div_n polyCM !mulrA -[_ * (_ ^+k)]mulrC !mulrA mulrAC.
-  rewrite -!mulrA -polyCM. mulfV. ?polyC1 ?mulr1 ?expf_eq0 ?subr_eq0 //.
+  rewrite /beta expr_div_n polyCM !mulrA -[_ * (_ ^+k)]mulrC !mulrA (mulrAC _ (((m - a) ^+ k)%:P)).
+  rewrite -!mulrA -polyCM mulfV ?polyC1 ?mulr1 ?expf_eq0 ?subr_eq0 //.
   by move/negPf: dma => ->; rewrite andbF.
 rewrite -(exprVn (b - a)) [(_ ^-1 ^+ _)%:P]polyC_exp.
 rewrite -exprMn_comm; last by exact: mulrC.
@@ -1817,10 +1817,10 @@ have qh :
                       ((half (a + b) - a)/(b - a)) d [eta nth 0 l] i *:
                   bernp ((a + b) / 2%:R) b d i.
     by move => [i ci] _; rewrite -help -help2 /= nth_mkseq.
-  rewrite (eq_bigr _ qt); apply: dicho_correct => //.
+  rewrite (eq_bigr _ qt); apply: dicho_correct; [exact: anb| |exact: qq].
   rewrite -[X in _ == X]double_half half_lin; apply/negP.
   by move/eqP/half_inj/addIr/eqP; apply/negP.
-apply: (IH) => //.
+apply: (IH); [|exact: dn0|exact: qn0| |exact: qh'| |].
       by case/andP : (mid_between altb) => it _; exact it.
     by rewrite size_mkseq.
   case ts0: (dicho 2%:R^-1 2%:R^-1 d [eta nth 0 l] 0 == 0).
diff --git a/theories/conv.v b/theories/conv.v
index 03ffb97..d7b4a66 100644
--- a/theories/conv.v
+++ b/theories/conv.v
@@ -225,7 +225,7 @@ End Conv.
 
 Section between.
 Variable R : realType.
-Let Plane := pair_vectType (regular_vectType R) (regular_vectType R).
+Let Plane : vectType _ := (R^o * R^o)%type.
 
 Lemma det_conv (p p' q r : Plane) (t : R) :
   det (p <| t |> p') q r = (det p q r : R^o) <| t |> det p' q r.
@@ -255,13 +255,21 @@ have [q0|q0] := eqVneq q 0%R; first by left.
 right.
 move:q0; rewrite -pair_eqE /= negb_and => /orP[|] q0.
    exists (1 - xcoord r / xcoord q)=>//.
-   rewrite -convC convrl add0r subr0; apply /eqP; rewrite -pair_eqE; apply /andP; split=>/=; have ->: forall (a: R) (b: (regular_vectType (Real.ringType R))), a *: b = a*b by lazy.
-   - by rewrite -mulrA [_^-1*_]mulrC divff // mulr1.
-   - by rewrite mulrC mulrA -e mulrC mulrA [_^-1*_]mulrC divff // mul1r.
+   rewrite -convC convrl add0r subr0; apply /eqP; rewrite -pair_eqE; apply /andP; split=>/=.
+   - apply/eqP.
+     transitivity ((xcoord r / xcoord q) * q.1) => //.
+     by rewrite -mulrA [_^-1*_]mulrC divff // mulr1.
+   - apply/eqP.
+     transitivity ((xcoord r / xcoord q) * q.2) => //.
+     by rewrite mulrC mulrA -e mulrC mulrA [_^-1*_]mulrC divff // mul1r.
 exists (1 - ycoord r / ycoord q)=>//.
-   rewrite -convC convrl add0r subr0; apply /eqP; rewrite -pair_eqE; apply /andP; split=>/=; have ->: forall (a: R) (b: regular_vectType (Real.ringType R)), a *: b = a*b by lazy.
-- by rewrite mulrC mulrA e mulrC mulrA [_^-1*_]mulrC divff // mul1r.
-- by rewrite -mulrA [_^-1*_]mulrC divff // mulr1.
+   rewrite -convC convrl add0r subr0; apply /eqP; rewrite -pair_eqE; apply /andP; split=>/=.
+   - apply/eqP.
+     transitivity ((ycoord r / ycoord q) * q.1) => //.
+     by rewrite mulrC mulrA e mulrC mulrA [_^-1*_]mulrC divff // mul1r.
+   - apply/eqP.
+     transitivity ((ycoord r / ycoord q) * q.2) => //.
+     by rewrite -mulrA [_^-1*_]mulrC divff // mulr1.
 Qed.
 
 Definition between (x y z : Plane) := [&& (det x y z == 0)%R,
diff --git a/theories/counterclockwise.v b/theories/counterclockwise.v
index fd273f2..581d0e0 100644
--- a/theories/counterclockwise.v
+++ b/theories/counterclockwise.v
@@ -1,6 +1,6 @@
 Require Export axiomsKnuth.
 From mathcomp Require Import all_ssreflect ssralg matrix ssrnum vector reals.
-From mathcomp Require Import normedtype order.
+From mathcomp Require Import normedtype order lra.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -24,7 +24,7 @@ Local Open Scope ring_scope.
 
 Section Plane.
 Variable R : realType.
-Definition Plane := pair_vectType (regular_vectType R) (regular_vectType R).
+Definition Plane : vectType _ := (R^o * R^o)%type.
 
 (* ------------------ Definitions ------------------- *)
 
@@ -89,7 +89,11 @@ Definition swap (p : Plane) := (p.2, p.1).
 
 Lemma det_scalar_productE (p q r: Plane):
   det p q r = scalar_product (q-p) (rotate (r-p)).
-Proof. by rewrite develop_det /scalar_product /=; ring. Qed.
+Proof.
+rewrite develop_det /scalar_product /=.
+rewrite /xcoord /ycoord /=.
+ring.
+Qed.
 
 Lemma scalar_productC (p q: Plane): scalar_product p q = scalar_product q p.
 Proof. by rewrite /scalar_product /= [p.1*_]mulrC [p.2*_]mulrC. Qed.
@@ -176,7 +180,7 @@ Lemma scalar_product_swap (p q : Plane) :
 Proof. by rewrite swap_sym swap_swap. Qed.
 
 Lemma det_swap (p q r : Plane) : det (swap p) (swap q) (swap r) = - det p q r.
-Proof. by rewrite 2!develop_det/swap/=; ring. Qed.
+Proof. by rewrite 2!develop_det/swap/= /xcoord/ycoord/=; ring. Qed.
 
 Lemma decompose_base (p q : Plane) : q != 0 ->
   p = (scalar_product p q) / (scalar_product q q) *: q +
@@ -246,7 +250,7 @@ case p0: (p == 0).
    case q0: (q == 0).
       move: q0=>/eqP q0; subst q.
       exists (1, 0); split.
-         by rewrite negb_and; apply/orP; left=>/=; apply oner_neq0.
+         by rewrite negb_and; apply/orP; left=>/=; apply: oner_neq0.
       by rewrite -(scale0r (0 : Plane)) scalar_productZR mul0r.
    exists (rotate q); split.
       apply/eqP=>/pair_equal_spec [q2 /eqP]; rewrite oppr_eq0=>/eqP q1.
diff --git a/theories/encompass.v b/theories/encompass.v
index f81fe6c..b5dc593 100644
--- a/theories/encompass.v
+++ b/theories/encompass.v
@@ -111,7 +111,7 @@ End spec.
 Module SpecKA (KA : KnuthAxioms).
 Section Dummy.
 Variable R : realType.
-Let plane := pair_vectType (regular_vectType R) (regular_vectType R).
+Let plane : vectType _ := (R^o * R^o)%type.
 
 Let oriented := KA.OT (R:=R).
 Let Ax1 := KA.Axiom1 (R:=R).
diff --git a/theories/hulls.v b/theories/hulls.v
index 507361d..650a1be 100644
--- a/theories/hulls.v
+++ b/theories/hulls.v
@@ -40,7 +40,7 @@ Implicit Types X Y : set A.
 Lemma subset_hull X : X `<=` hull X.
 Proof.
 move=> x xX; rewrite /hull; exists 1%N, (fun=> x), (fun=>1%R).
-split=> //; first by move=>_; exact ler01.
+split=> //.
 - by rewrite big_ord_recl big_ord0 addr0.
 - by move=> d [i _ <-].
 - by rewrite big_ord_recl big_ord0 scale1r addr0.
@@ -256,14 +256,14 @@ wlog: l lu ls ll f f0 f1 i ilt / l`_i == 0%R.
    move=>h.
    set l' := [seq x - l`_i | x <- l].
    have subl': forall a b, (a < size l) -> (b < size l) -> l'`_a - l'`_b = l`_a - l`_b.
-      by move=>a b al bl; rewrite (nth_map (GRing.zero _))// (nth_map (GRing.zero _))// opprD [-_ - - _]addrC -!addrA; congr GRing.add; rewrite addrA subrr add0r.
+      by move=>a b al bl; rewrite (nth_map 0)// (nth_map 0)// opprD [-_ - - _]addrC -!addrA; congr GRing.add; rewrite addrA subrr add0r.
    suff: (0%:R <= det l'`_i l'`_(Zp_succ (Ordinal ilt)) (\sum_(i0 < size l) f i0 *: l'`_i0))%R.
       congr (_ <= _)%R; rewrite 2!det_scalar_productE; congr (scalar_product _ (rotate _)).
       - by apply subl'=>//; case: (Zp_succ (Ordinal ilt)).
-      - rewrite [l'`_i](nth_map (GRing.zero _))// subrr subr0 -[l`_i]scale1r.
+      - rewrite [l'`_i](nth_map 0)// subrr subr0 -[l`_i]scale1r.
       have->: (1 = 1%:R)%R by [].
       rewrite -f1 scaler_suml -sumrB; apply congr_big=>// [[j jlt]] _.
-      by rewrite -scalerBr (nth_map (GRing.zero _)).
+      by rewrite -scalerBr (nth_map 0).
    move:h=>/(_ l'); rewrite size_map; apply.
       - rewrite map_inj_uniq=>//; apply addIr.
       - by [].
@@ -280,7 +280,7 @@ wlog: l lu ls ll f f0 f1 i ilt / l`_i == 0%R.
       by move:ll; rewrite Spec.encompassll_spec=>// /andP[_] /forallP /(_ (Ordinal alt)) /forallP /(_ (Ordinal blt)) /forallP /(_ (Ordinal clt)) /implyP /(_ abc); rewrite /ccw_KA.OT /ccw det_scalar_productE.
       - apply f0.
       - exact f1.
-      - by rewrite (nth_map (GRing.zero _))// subrr.
+      - by rewrite (nth_map 0)// subrr.
 move=>/eqP li0; rewrite li0 det_sum; apply sumr_ge0=>[[j jlt]] _.
 rewrite det_scalar_productE 2!subr0 rotateZ scalar_productZR; apply mulr_ge0.
    apply f0.
diff --git a/theories/intersection.v b/theories/intersection.v
index 7baa8d0..74335e7 100644
--- a/theories/intersection.v
+++ b/theories/intersection.v
@@ -56,7 +56,7 @@ Proof. by rewrite/intersect separateCr; congr andb; apply separateCl. Qed.
 Lemma intersect_correct a b c d : intersect a b c d ->
   exists p, between p a b && between p c d.
 Proof.
-have sm t u : t *: (u : regular_lmodType R) = t * u by [].
+have sm t u : t *: (u : R^o) = t * u by [].
 wlog abc0: a b c d / 0 <= det a b c.
    move=>h.
    case ge0: (0 <= det a b c); first by apply h.
@@ -109,7 +109,7 @@ Qed.
 Lemma intersect_complete a b c d :
   (exists p, between p a b && between p c d) -> intersect a b c d.
 Proof.
-have sm: forall t u, t *: (u : regular_lmodType R) = t*u by [].
+have sm: forall t u, t *: (u : R^o) = t*u by [].
 move:a b c d.
 suff: forall a b c d, (exists p : counterclockwise.Plane R, between p a b && between p c d) -> separate a b c d.
    move=> h a b c d abcd; apply/andP; split; apply h=>//.
@@ -232,8 +232,8 @@ wlog : a b t u lab t01 ltab u01 luab / (t == 0) && (u == 1).
      apply/negP => /intersect_correct[p]/andP[pl pab].
      move: (lab i) => /negP; apply; apply intersect_complete.
      exists p; apply/andP; split=>//; refine (between_trans _ _ pab).
-       by apply between_conv; eexists; apply/andP; split => //.
-     by apply between_conv; eexists; apply/andP; split => //.
+       by apply between_conv; exists u; apply/andP; split => //.
+     by apply between_conv; exists t; apply/andP; split => //.
    - by apply in010.
    - by rewrite conv0.
    - by apply in011.
@@ -299,7 +299,7 @@ have : [exists i : 'I_(size l), det l`_i l`_i.+1mod (b <| sup I |> a) <= 0].
   have tfin : (fine (mine t 1%:E))%:E = mine t 1%:E.
     apply/(@fineK R)/fin_numP; split; apply/negP=>/eqP tinf.
       suff : (-oo < mine t 1)%E by rewrite tinf ltxx.
-      rewrite ltxI; apply/andP; split; last by apply ltNye.
+      rewrite ltxI; apply/andP; split; last by apply: ltNye.
       by apply ereal_meets_gt=>// i _; apply ltNye.
     suff : (mine t 1 < +oo)%E by rewrite tinf ltxx.
     by rewrite ltIx [(1 < +oo)%E]ltey orbT.
@@ -307,7 +307,7 @@ have : [exists i : 'I_(size l), det l`_i l`_i.+1mod (b <| sup I |> a) <= 0].
   have t01: in01 (fine (mine t 1%E)).
     apply/andP; split; rewrite -lee_fin tfin; last by rewrite lteIx le_refl orbT.
     rewrite ltexI; apply/andP; split; last by rewrite lee_fin ler01.
-    apply: meets_ge => i abgt; rewrite lee_fin; apply: (mulr_ge0 (la _)).
+    apply: Order.TLatticeTheory.meets_ge => i abgt; rewrite lee_fin; apply: (mulr_ge0 (la _)).
     by apply ltW; rewrite invr_gt0 -2![det l`_i _ _]det_cyclique.
   apply: sup_upper_bound => //; apply/andP; split => //.
   rewrite encompass_all_index l0/=; apply/forallP => i.
@@ -318,7 +318,7 @@ have : [exists i : 'I_(size l), det l`_i l`_i.+1mod (b <| sup I |> a) <= 0].
     rewrite -subr_ge0 -(pmulr_lge0 _ abgt0) mulrBl subr_ge0 -mulrA divff// mulr1.
     rewrite -lee_fin tfin leIx; apply/orP; left.
     rewrite ![det _ l`_i _]det_cyclique /t.
-    by move:abgt0; rewrite invr_gt0=>abgt; exact: meets_inf.
+    by move:abgt0; rewrite invr_gt0=>abgt; exact: Order.TLatticeTheory.meets_inf.
   rewrite {2}[det a _ _]det_cyclique (le_trans _ (la i))// mulr_ge0_le0 //.
   by move:t01 => /andP[].
 move=> /existsP[i] iable0.
diff --git a/theories/isolate.v b/theories/isolate.v
index 362f268..b908beb 100644
--- a/theories/isolate.v
+++ b/theories/isolate.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq choice fintype order.
 From mathcomp Require Import div finfun bigop prime binomial ssralg finset fingroup finalg.
 From mathcomp Require Import mxalgebra perm zmodp matrix ssrint.
@@ -147,7 +148,7 @@ Section count_root_correct.
 
 Variable R : archiFieldType.
 
-Definition R' := RealAlg.alg_of_rcfType R.
+(*TODO(rei, gave up when moving to MathComp 2): Definition R' : archiFieldType := (R : rcfType).*)
 
 (*
 Lemma count_root_correct0 n (l : seq rat) q d (a b: R') :
@@ -318,13 +319,13 @@ case: (In d a ((a + b) / (1+1)) (dicho_l d l) (l1++acc)) => [l2 l2q].
 by exists (l2++l1); rewrite l1q l2q -!catA.
 Qed.*)
 
-Canonical root_info_eqMixin (R : eqType) := EqMixin (root_info_eqP R).
+HB.instance Definition _ := hasDecEq.Build _ (root_info_eqP R).
 
-Canonical root_info_eqType (R : eqType) :=
+(*Canonical root_info_eqType (R : eqType) :=
    Eval hnf in EqType (root_info R) (root_info_eqMixin R).
 
 Arguments root_info_eqP {R x y}.
-Prenex Implicits root_info_eqP.
+Prenex Implicits root_info_eqP.*)
 
 
 (* NB(rei): typing issue with {realclosure _}
diff --git a/theories/pol.v b/theories/pol.v
index 0bb7f36..ddaf53b 100644
--- a/theories/pol.v
+++ b/theories/pol.v
@@ -440,10 +440,14 @@ Lemma shift_poly_is_linear c: linear (shift_poly c).
 Proof. by move=> a u v; rewrite /shift_poly comp_polyD comp_polyZ. Qed.
 
 Lemma shift_poly_multiplicative c: multiplicative (shift_poly c).
-Proof.   
+Proof.
 split. move=> x y; exact: comp_polyM. by rewrite /shift_poly comp_polyC.
 Qed.
 
+HB.instance Definition _ (c : R) := GRing.isLinear.Build _ _ _ _ _ (shift_poly_is_linear c).
+
+HB.instance Definition _ c := GRing.isMultiplicative.Build _ _ _ (shift_poly_multiplicative c).
+
 (*HB.instance Definition _ c := GRing.isLinear.Build _ _ _ _ _ (shift_poly_is_linear c).
 
 Canonical shift_poly_additive c := Additive (shift_poly_is_linear c).
diff --git a/theories/preliminaries_hull.v b/theories/preliminaries_hull.v
index 86607bd..667a501 100644
--- a/theories/preliminaries_hull.v
+++ b/theories/preliminaries_hull.v
@@ -36,8 +36,8 @@ elim: m n=>[| m IHm] n.
    rewrite /addn/addn_rec-plus_n_O.
    move:(size_iota n 0)=>/size0nil->/=; apply/esym/negbTE.
    rewrite negb_and orbC -implybE; apply/implyP=>/forallP lmono; rewrite -ltnNge.
-   elim:l a {IHl} lmono=>[| b l IHl] a; first by move=>/(_ 0).
-   by move=>lmono; apply (ltn_trans (lmono 0)); apply IHl=>i/=; apply (lmono (lift ord0 i)).
+   elim:l a {IHl} lmono=>[| b l IHl] a; first by move=>/(_ ord0).
+   by move=>lmono; apply (ltn_trans (lmono ord0)); apply IHl=>i/=; apply (lmono (lift ord0 i)).
 rewrite/iota-/(iota n.+1 m)/subseq.
 case: ifP.
    move=>/eqP an; subst a.
@@ -216,18 +216,21 @@ Variable (R : realDomainType).
 Local Open Scope ereal_scope.
 
 (* PRed to MathComp-Analysis: https://github.com/math-comp/analysis/pull/859 *)
+(*
 Definition ereal_blatticeMixin :
   Order.BLattice.mixin_of (Order.POrder.class (@ereal_porderType R)).
 exists (-oo); exact leNye.
 Defined.
 Canonical ereal_blatticeType := BLatticeType (\bar R) ereal_blatticeMixin.
 
+
 Definition ereal_tblatticeMixin :
   Order.TBLattice.mixin_of (Order.POrder.class (ereal_blatticeType)).
 exists (+oo); exact leey.
 Defined.
 Canonical ereal_tblatticeType := TBLatticeType (\bar R) ereal_tblatticeMixin.
 (* /PRed *)
+*)
 
 (* Note: Should be generalized to tbLatticeType+orderType, but such a structure is not defined. *)
 Lemma ereal_joins_lt
diff --git a/theories/three_circles.v b/theories/three_circles.v
index b0dacba..e782a95 100644
--- a/theories/three_circles.v
+++ b/theories/three_circles.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect.
 From mathcomp Require Import ssralg poly polydiv polyorder ssrnum zmodp.
 From mathcomp Require Import polyrcf qe_rcf_th complex.
@@ -153,9 +154,11 @@ Proof.
 split. move=> x y; exact: comp_polyM. by rewrite /scaleX_poly comp_polyC.
 Qed.
 
-Canonical scaleX_poly_additive (c : R) := Additive (scaleX_poly_is_linear c).
-Canonical scaleX_poly_linear c := Linear (scaleX_poly_is_linear c).
-Canonical scaleX_poly_rmorphism c := AddRMorphism (scaleX_poly_multiplicative c).
+HB.instance Definition _ (c : R) := GRing.isLinear.Build _ _ _ _ _ (scaleX_poly_is_linear c).
+
+HB.instance Definition _ c := GRing.isMultiplicative.Build _ _ _ (scaleX_poly_multiplicative c).
+
+(*Canonical scaleX_poly_rmorphism c := AddRMorphism (scaleX_poly_multiplicative c).*)
 
 Lemma scaleX_polyC (c a : R) : a%:P \scale c = a%:P.
 Proof. by rewrite /scaleX_poly comp_polyC. Qed.
@@ -302,7 +305,7 @@ Proof.
 move=> Hp.
 have H0noroot : ~~(root (p %/ 'X^(\mu_0 p)) 0).
   rewrite -mu_gt0.
-    rewrite -eqn0Ngt -(addr0 'X) -(@oppr0 (poly_zmodType R)) -polyC0 mu_div
+    rewrite -eqn0Ngt -(addr0 'X) -(@oppr0 {poly R}) -polyC0 mu_div
       ?subn_eq0; by rewrite leqnn.
   rewrite Pdiv.CommonIdomain.divp_eq0 negb_or Hp /= negb_or.
   rewrite -size_poly_gt0 {1}size_polyXn /= -leqNgt dvdp_leq //.
@@ -583,9 +586,7 @@ rewrite -exprMn -(ler_sqrt (b^+2)).
     rewrite -(pmulr_lge0 (x:=Num.sqrt 3%:R)); last by rewrite sqrtr_gt0 ltr0n.
     by rewrite mulrC (@le_trans _ _ `| b |).
   by rewrite -oppr_ge0 Ha2 /= -(normrN (a-1)) (ger0_norm (x:= -(a-1))).
-rewrite exprMn mulr_gt0 // lt_def sqr_ge0.
-  by rewrite sqrf_eq0 sqrtr_eq0 -ltNge ltr0n.
-by rewrite sqrf_eq0 Ha.
+by rewrite exprMn mulr_ge0 // ?sqr_ge0//.
 Qed.
 
 Lemma Re_invc (z : C) : Re z^-1 = Re z / ((Re z) ^+ 2 + (Im z) ^+2).

From c29569b4c5419b867f929f94c15d8fcd81d9a465 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Tue, 23 Apr 2024 11:23:12 +0900
Subject: [PATCH 08/43] add proofs

---
 theories/cells.v                 | 1392 ++++++
 theories/cells_alg.v             | 6955 ++++++++++++++++++++++++++++++
 theories/events.v                |  514 +++
 theories/math_comp_complements.v |  271 ++
 theories/opening_cells.v         | 1395 ++++++
 theories/points_and_edges.v      | 2817 ++++++++++++
 theories/safe_cells.v            |  735 ++++
 7 files changed, 14079 insertions(+)
 create mode 100644 theories/cells.v
 create mode 100644 theories/cells_alg.v
 create mode 100644 theories/events.v
 create mode 100644 theories/math_comp_complements.v
 create mode 100644 theories/opening_cells.v
 create mode 100644 theories/points_and_edges.v
 create mode 100644 theories/safe_cells.v

diff --git a/theories/cells.v b/theories/cells.v
new file mode 100644
index 0000000..6707b6e
--- /dev/null
+++ b/theories/cells.v
@@ -0,0 +1,1392 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import math_comp_complements generic_trajectories points_and_edges
+  events.
+
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section working_environment.
+
+Variable R : realFieldType.
+
+Notation pt := (pt R).
+Notation Bpt := (Bpt R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+Notation edge := (edge R).
+Notation event := (event R edge).
+Notation point := (point R edge).
+Notation outgoing := (outgoing R edge).
+
+Notation cell := (cell R edge).
+Notation Bcell := (Bcell R edge).
+Notation low := (low R edge).
+Notation high := (high R edge).
+Notation left_pts := (left_pts R edge).
+Notation right_pts := (right_pts R edge).
+
+Definition cell_eqb (ca cb : cell) : bool :=
+  let: generic_trajectories.Bcell lptsa rptsa lowa higha := ca in
+  let: generic_trajectories.Bcell lptsb rptsb lowb highb:= cb in
+  (lptsa == lptsb :> seq pt) && (rptsa == rptsb :> seq pt) &&
+  (lowa == lowb) && (higha == highb).
+
+Lemma cell_eqP : Equality.axiom cell_eqb.
+Proof.
+rewrite /Equality.axiom.
+move => [lptsa rptsa lowa higha] [lptsb rptsb lowb highb] /=.
+have [/eqP <-|/eqP anb] := boolP(lptsa == lptsb :> seq pt).
+  have [/eqP <-|/eqP anb] := boolP(rptsa == rptsb :> seq pt).
+    have [/eqP <-|/eqP anb] := boolP(lowa == lowb).
+      have [/eqP <-|/eqP anb] := boolP(higha == highb).
+        by apply:ReflectT.
+      by apply : ReflectF => [][].
+    by apply : ReflectF => [][].
+  by apply: ReflectF=> [][].
+by apply: ReflectF=> [][].
+Qed.
+
+Canonical cell_eqType := EqType cell (EqMixin cell_eqP).
+
+Definition valid_cell c x := valid_edge (low c) x /\ valid_edge (high c) x.
+
+Lemma order_edges_viz_point c p :
+valid_edge (low c) p -> valid_edge (high c) p ->
+(low c) <| (high c) ->
+p <<= (low c) -> p <<= (high c).
+Proof. apply : order_edges_viz_point'. Qed.
+
+Lemma order_edges_strict_viz_point c p :
+valid_edge (low c) p -> valid_edge (high c) p ->
+(low c) <| (high c) ->
+p <<< (low c) ->  p <<< (high c).
+Proof. apply: order_edges_strict_viz_point'. Qed.
+
+Definition unsafe_Bedge (a b : pt) :=
+  if (ltrP (p_x a) (p_x b)) is LtrNotGe h then Bedge h else
+    Bedge (ltr01 : p_x (Bpt 0 0) < p_x (Bpt 1 0)).
+
+Notation dummy_pt := (generic_trajectories.dummy_pt R 1).
+Notation dummy_event := (generic_trajectories.dummy_event R 1 edge).
+Notation dummy_edge := (generic_trajectories.dummy_edge R 1 edge unsafe_Bedge).
+Notation dummy_cell := (dummy_cell R 1 edge unsafe_Bedge).
+
+Definition head_cell (s : seq cell) := head dummy_cell s.
+Definition last_cell (s : seq cell) := last dummy_cell s.
+
+Definition contains_point :=
+  contains_point R eq_op le +%R (fun x y => x - y) *%R 1 edge
+  (@left_pt R) (@right_pt R).
+
+Lemma contains_pointE p c :
+  contains_point p c = (p >>= low c) && (p <<= high c).
+Proof. by []. Qed.
+
+Definition contains_point' (p : pt) (c : cell)  : bool :=
+   (p >>> low c) && (p <<= (high c)).
+
+Lemma contains_point'W p c :
+  contains_point' p c -> contains_point p c.
+by move=> /andP[] /underWC A B; rewrite contains_pointE A B.
+Qed.
+
+Definition open_limit c :=
+  min (p_x (right_pt (low c))) (p_x (right_pt (high c))).
+
+Definition bottom_left_corner (c : cell) := last dummy_pt (left_pts c).
+
+Definition bottom_left_cells_lex (open : seq cell) p :=
+  {in open, forall c, lexPt (bottom_left_corner c) p}.
+
+Definition left_limit (c : cell) :=
+  p_x (last dummy_pt (left_pts c)).
+
+Definition right_limit c := p_x (last dummy_pt (right_pts c)).
+
+Definition inside_open_cell p c :=
+  [&& contains_point p c & left_limit c <= p_x p <= open_limit c].
+
+Definition inside_open' p c :=
+  [&& inside_open_cell p c,  p >>> low c & left_limit c < p_x p] .
+
+Lemma inside_open'E p c :
+  inside_open' p c =
+  [&& p <<= high c, p >>> low c, left_limit c < p_x p &
+   p_x p <= open_limit c].
+Proof.
+rewrite /inside_open' /inside_open_cell contains_pointE.
+rewrite /point_strictly_under_edge strictE -leNgt !le_eqVlt.
+rewrite [in _ >>> low c]/point_under_edge -ltNge subrr.
+by case: (0 < _); case: (_ < p_x p); rewrite ?andbF ?orbT ?andbT.
+Qed.
+
+Definition inside_closed_cell p c :=
+  contains_point p c && (left_limit c <= p_x p <= right_limit c).
+
+Definition inside_closed' p c :=
+  [&& inside_closed_cell p c, p >>> low c & left_limit c < p_x p].
+
+Lemma inside_closed'E p c :
+  inside_closed' p c =
+  [&& p <<= high c, p >>> low c, left_limit c < p_x p &
+     p_x p <= right_limit c].
+Proof.
+rewrite /inside_closed' /inside_closed_cell contains_pointE.
+rewrite /point_strictly_under_edge.
+rewrite strictE -leNgt !le_eqVlt.
+rewrite [in _ >>> low c]/point_under_edge -ltNge subrr.
+by case: (0 < _); case: (_ < p_x p); rewrite ?andbF ?orbT ?andbT.
+Qed.
+
+Definition in_safe_side_left p c :=
+  [&& p_x p == left_limit c, p <<< high c, p >>> low c &
+      p \notin (left_pts c : seq pt)].
+
+Definition in_safe_side_right p c :=
+  [&& p_x p == right_limit c, p <<< high c, p >>> low c &
+      p \notin (right_pts c : seq pt)].
+
+Section proof_environment.
+Variable bottom top : edge.
+
+Definition between_edges (l h : edge) (p : pt) :=
+  (p >>> l) && (p <<< h).
+
+Definition inside_box p :=
+(~~ (p <<= bottom)  && (p <<< top) ) &&
+  ((p_x (left_pt bottom) < p_x p < p_x (right_pt bottom)) &&
+  (p_x (left_pt top) < p_x p < p_x (right_pt top))).
+
+(* this function removes consecutives duplicates, meaning the seq needs
+ to be sorted first if we want to remove all duplicates *)
+Fixpoint no_dup_seq (A : eqType) (s : seq A) : (seq A) :=
+  match s with
+  | [::] => [::]
+  | a::q => match q with
+            | [::] => s
+            | b::r => if a == b then no_dup_seq q else a::(no_dup_seq q)
+            end
+    end.
+
+Lemma no_dup_seq_aux_eq {A : eqType} (s : seq A) :
+  no_dup_seq s = no_dup_seq_aux eq_op s.
+Proof. by elim: s => [ | a s /= ->]. Qed.
+
+Definition close_cell (p : pt) (c : cell) :=
+  match vertical_intersection_point p (low c),
+        vertical_intersection_point p (high c) with
+  | None, _ | _, None => c
+  | Some p1, Some p2 => 
+    Bcell (left_pts c) (no_dup_seq [:: p1; p; p2]) (low c) (high c)
+  end.
+
+Definition closing_cells (p : pt) (contact_cells: seq cell) : seq cell :=
+  [seq close_cell p c | c <- contact_cells].
+
+Lemma close_cell_preserve_3sides p c :
+  [/\ low (close_cell p c) = low c,
+      high (close_cell p c) = high c &
+      left_pts (close_cell p c) = left_pts c].
+Proof.
+rewrite /close_cell.
+case: (vertical_intersection_point p (low c))=> [p1 | ] //.
+by case: (vertical_intersection_point p (high c))=> [p2 | ].
+Qed.
+
+Lemma right_limit_close_cell p1 c :
+  valid_edge (low c) p1 -> valid_edge (high c) p1 ->
+  right_limit (close_cell p1 c) = p_x p1.
+Proof.
+move=> vlc vhc; rewrite /close_cell /right_limit.
+rewrite !pvertE //=.
+by case: ifP; case: ifP.
+Qed.
+
+Lemma left_limit_close_cell p1 c :
+   left_limit (close_cell p1 c) = left_limit c.
+Proof.
+rewrite /close_cell.
+by do 2 (case: (vertical_intersection_point _ _) => //).
+Qed.
+
+Lemma inside_box_between p : inside_box p -> between_edges bottom top p.
+Proof.  by move=> /andP[]. Qed.
+
+Lemma inside_box_valid_bottom_top p g :
+  inside_box p ->
+  g \in [:: bottom; top] -> valid_edge g p.
+Proof.
+move=>/andP[] _ /andP[] /andP[] /ltW a /ltW b /andP[] /ltW c /ltW d.
+rewrite /valid_edge/generic_trajectories.valid_edge. 
+by rewrite !inE=> /orP[] /eqP ->; rewrite ?(a, b, c, d).
+Qed.
+
+Definition end_edge_ext (g : edge) (evs : seq event) :=
+  (g \in [:: bottom; top]) || end_edge g evs.
+
+Lemma end_edgeW g evs : end_edge g evs -> end_edge_ext g evs.
+Proof. by rewrite /end_edge_ext=> ->; rewrite orbT. Qed.
+
+Definition close_alive_edges open future_events : bool :=
+all (fun c => (end_edge_ext (low c) future_events) &&
+    (end_edge_ext (high c) future_events)) open.
+
+Lemma insert_opening_all (first_cells  new_open_cells last_cells : seq cell) p :
+all p first_cells  -> all p new_open_cells  ->
+  all p last_cells  -> all p (first_cells++new_open_cells++ last_cells).
+Proof.
+move => C_first C_new C_last.
+ rewrite  all_cat all_cat.
+apply /andP.
+split.
+  by [].
+apply /andP.
+split.
+  by [].
+by [].
+Qed.
+
+Lemma insert_opening_closeness first_cells new_open_cells last_cells events :
+  close_alive_edges first_cells events -> close_alive_edges new_open_cells events ->
+  close_alive_edges last_cells events -> close_alive_edges (first_cells++new_open_cells++ last_cells) events.
+Proof.
+apply insert_opening_all.
+Qed.
+
+Definition adj_rel := [rel x y : cell | high x == low y].
+
+Definition adjacent_cells := sorted adj_rel.
+
+Lemma adjacent_catW s1 s2 : 
+  adjacent_cells (s1 ++ s2) -> adjacent_cells s1 /\ adjacent_cells s2.
+Proof.
+case: s1 => [ // | cs1  s1 /=]; rewrite /adjacent_cells.
+rewrite cat_path => /andP[] -> ps2; split=> //.
+by move/path_sorted: ps2.
+Qed.
+
+Lemma adjacent_cut l2 a lc :
+l2 != nil ->
+((high (last dummy_cell l2) == low a) &&
+adjacent_cells l2 &&
+adjacent_cells (a::lc) ) =
+adjacent_cells (l2 ++ a::lc).
+Proof.
+case : l2 => [//= | c2 q2 _].
+elim : q2 c2 => [ | c3 q3 IH]  c2 //=.
+by rewrite andbT.
+have /= IH' := IH c3.
+rewrite andbCA.
+rewrite -IH'.
+by rewrite !andbA.
+Qed.
+
+Definition bottom_edge_seq_above (s : seq cell) (p : pt) :=
+  if s is c :: _ then (p) <<= (low c) else true.
+
+Definition bottom_edge_seq_below (s : seq cell) (p : pt) :=
+  if s is c :: _ then ~~ (p <<< low c) else true.
+
+Lemma strict_under_cell (c : cell) (p : pt) :
+  valid_cell c p ->
+  low c <| high c -> p <<= (low c) -> ~~ contains_point p c ->
+  p <<< (low c).
+Proof.
+move=> valcp rfc.
+move: (valcp)=> [vallp valhp].
+rewrite (under_onVstrict vallp) => /orP [] //.
+move=> ponl; rewrite /contains_point negb_and negbK=> /orP[] //.
+case/negP.
+apply: (order_edges_viz_point vallp) => //.
+by rewrite under_onVstrict // ponl.
+Qed.
+
+Definition s_right_form (s : seq cell)  : bool :=
+  all (fun c => low c <| high c ) s.
+
+Definition seq_valid (s : seq cell) (p : pt) : bool :=
+    all (fun c => (valid_edge (low c) p) && (valid_edge (high c) p)) s.
+
+Lemma seq_valid_high (s : seq cell) (p : pt) :
+  seq_valid s p -> {in [seq high i | i <- s], forall g, valid_edge g p}.
+Proof.
+by move=> sval g /mapP [c cin ->]; move: (allP sval c cin)=> /andP[].
+Qed.
+
+Lemma seq_valid_low (s : seq cell) (p : pt) :
+  seq_valid s p -> {in [seq low i | i <- s], forall g, valid_edge g p}.
+Proof.
+by move=> sval g /mapP [c cin ->]; move: (allP sval c cin)=> /andP[].
+Qed.
+
+Lemma insert_opening_valid fc nc lc p :
+  [&& seq_valid fc p, seq_valid nc p & seq_valid lc p] =
+  seq_valid (fc ++ nc ++ lc) p.
+Proof.
+by rewrite /seq_valid !all_cat.
+Qed.
+
+Lemma strict_under_seq p c q :
+  adjacent_cells (c :: q) ->
+  seq_valid (c :: q) p ->
+  s_right_form (c :: q) ->
+  p <<< (low c) ->
+  forall c1, c1 \in q -> p <<< (low c1).
+Proof.
+elim: q c => [// | c' q Ih] c adj vals rfs plow c1 c1in.
+move: adj; rewrite /adjacent_cells /= => /andP[/eqP eq_edges adj'].
+move: vals; rewrite /seq_valid /= => /andP[/andP[vallc valhc] valc'q].
+move: rfs; rewrite /s_right_form /= => /andP[lowhigh rfc'q].
+have pc' : p <<< (low c').
+  by rewrite -eq_edges; apply: (order_edges_strict_viz_point vallc).
+have [/eqP c1c' | c1nc'] := boolP (c1 == c').
+  by rewrite c1c'.
+apply: (Ih c')=> //.
+  by move: c1in; rewrite !inE (negbTE c1nc').
+Qed.
+
+Lemma strict_under_seq' p c q :
+  adjacent_cells (c :: q) ->
+  seq_valid (c :: q) p ->
+  s_right_form (c :: q) ->
+  p <<< (low c) ->
+  forall c1, c1 \in (c :: q) -> p <<< (low c1).
+Proof.
+move=> adj sv rf pl c1; rewrite inE=> /orP[/eqP -> // | ].
+by apply: (strict_under_seq adj sv rf pl).
+Qed.
+
+Lemma close_imp_cont c e :
+low c <| high c ->
+valid_edge (low c) (point e) /\ valid_edge (high c) (point e) ->
+event_close_edge (low c) e \/  event_close_edge (high c) e ->
+contains_point (point e) c.
+Proof.
+rewrite contains_pointE /event_close_edge .
+move =>  rf val [/eqP rlc | /eqP rhc].
+move : rf val.
+  rewrite /point_strictly_under_edge !strictE -rlc {rlc e}.
+  have := (area3_two_points (right_pt (low c)) (left_pt (low c))) => [][] _ [] /eqP -> _ .
+  rewrite lt_irreflexive /=.
+  rewrite /edge_below.
+  move => /orP [] /andP [] //= => pablhlow pabrhlow [] _ validrlhigh.
+  apply: not_strictly_above pablhlow pabrhlow validrlhigh.
+  move : rf val.
+rewrite /point_under_edge underE -rhc {rhc}.
+have := (area3_two_points (right_pt (high c)) (left_pt (high c))) => [] [] _ [] /eqP -> _ /=.
+rewrite le_refl /edge_below /= andbT=> /orP [] /andP [] //= => pablhlow pabrhlow [] valrhlow _ .
+apply : not_strictly_under pablhlow pabrhlow valrhlow.
+Qed.
+
+Lemma contrapositive_close_imp_cont c e :
+low c <| high c->
+valid_edge (low c) (point e) /\ valid_edge (high c) (point e) ->
+~ contains_point (point e) c ->
+~ event_close_edge (low c) e /\ ~ event_close_edge (high c) e.
+Proof.
+  move => rf val ev.
+have aimpb := (close_imp_cont rf val).
+have  := (@contra_not  ( contains_point (point e) c) (event_close_edge (low c) e \/ event_close_edge (high c) e) aimpb ev) .
+move => /orP /= .
+rewrite negb_or.
+by move => /andP [] /negP a /negP.
+Qed.
+
+Lemma adjacent_cons a q : adjacent_cells (a :: q) -> adjacent_cells q.
+Proof.
+by rewrite /=; case: q => [// | b q]; rewrite /= => /andP[].
+Qed.
+
+
+(* this lemma below is not true, see the counter example below.
+Lemma lowest_above_all_above (s : seq cell) p :
+s != [::] ->
+adjacent_cells s ->
+s_right_form s ->
+ p <<< (low (head dummy_cell s)) ->
+forall c, (c \in s) ->   p<<< (low c) /\  p <<< (high c) .
+Proof.
+case: s => [// | c q].
+*)
+
+Lemma lowest_above_all_above_counterexample :
+  ~(forall (s : seq cell) p,
+       s != [::] -> adjacent_cells s ->
+       s_right_form s -> p <<< (low (head dummy_cell s)) ->
+      forall c, (c \in s) ->   p<<< (low c) /\  p <<< (high c)).
+Proof.
+move=> abs.
+set e1 := @Bedge R (Bpt 0 1) (Bpt 1 1) ltr01.
+set e2 := @Bedge R (Bpt 0 2) (Bpt 1 1) ltr01.
+set p := (Bpt 3%:R 0).
+set c := Bcell [::] [::] e1 e2.
+have exrf : s_right_form [:: c].
+  rewrite /= /= /e1 /e2 /edge_below /= /point_under_edge !underE /=.
+  rewrite /point_strictly_under_edge  !strictE /=.
+  rewrite !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK, addrK).
+  rewrite le_refl lt_irreflexive /= !andbT.
+  rewrite -[X in X - 2%:R]/(1%:R) -opprB -natrB //  -[(2-1)%N]/1%N.
+  by rewrite lerN10.
+have plow : p <<< low (head dummy_cell [:: c]).
+  rewrite /point_strictly_under_edge strictE /=.
+  by rewrite !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK) ltrN10.
+have := abs [::c] p isT isT exrf  plow c.
+rewrite inE=> /(_ (eqxx _))=> [][] _.
+rewrite /point_strictly_under_edge strictE /=.
+rewrite
+  !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK, mulr1, addrK).
+rewrite -natrM -!natrB // -[X in X%:R]/(1%N).
+by rewrite ltNge ler0n.
+Qed.
+
+Definition cells_low_e_top cells low_e : bool :=
+  (cells != nil) && (low (head dummy_cell cells) == low_e) && (high (last dummy_cell cells) == top).
+
+Definition cells_bottom_top cells : bool :=
+  cells_low_e_top cells bottom.
+
+Lemma bottom_imp_seq_below s p :
+cells_bottom_top s -> inside_box p -> bottom_edge_seq_below s p.
+Proof.
+case s=> [// | c q].
+rewrite /cells_bottom_top /cells_low_e_top => /andP []/andP [] _ /eqP /= loweq _.
+rewrite /bottom_edge_seq_below  /inside_box loweq => /andP [] /andP []  /negP nsab _ _ /=.
+by apply /underWC/negP.
+Qed.
+
+Lemma exists_cell_aux low_e p open :
+cells_low_e_top open low_e -> adjacent_cells open ->
+p >>> low_e ->  p <<< top ->
+exists2 c : cell, c \in open & contains_point' p c.
+Proof.
+elim : open low_e => [//= | c0 q IH ].
+case cont : (contains_point' p c0).
+  by exists c0; rewrite ?cont ?inE ?eqxx.
+have := (IH (high c0)).
+move => IH' low_e {IH}.
+rewrite /cells_low_e_top => /andP[] /andP [] _ /= /eqP <- hightop.
+move=> adj lowunder topabove.
+  have : cells_low_e_top q (high c0).
+  rewrite /cells_low_e_top /=.
+  have qnnil: q!= nil.
+    move : hightop lowunder topabove  cont {IH'} adj.
+    case : q => //=.
+    rewrite  /contains_point' /=.
+    by move=> /eqP -> -> /underW ->.
+  rewrite qnnil /=.
+  move : hightop qnnil adj IH'.
+  case : q => [ // | a q /=].
+  move => hightop.
+  by rewrite hightop eq_sym => _ /andP [] ->.
+move => lowtop /=.
+rewrite /contains_point' in cont.
+move : lowunder cont  => -> /= /negbT phc.
+have := (IH' lowtop (path_sorted adj) phc topabove) .
+move => [] x xinq cpx.
+by exists x; rewrite ?in_cons ?xinq /= ?orbT ?cpx.
+Qed.
+
+Lemma exists_cell  p open :
+cells_bottom_top open -> adjacent_cells open  ->
+between_edges bottom top p ->
+exists2 c : cell, c \in open & contains_point' p c.
+Proof.
+move=> cbtom adj /[dup] inbox_e /andP[] pa pu.
+by apply:  (exists_cell_aux cbtom adj).
+Qed.
+
+Definition cell_edges cells := map low cells ++ map high cells.
+
+Lemma head_not_end q e future_events :
+close_alive_edges q (e :: future_events) ->
+(forall c, (c \in q) ->
+~ event_close_edge (low c) e /\ ~ event_close_edge (high c) e) ->
+close_alive_edges q (future_events).
+Proof.
+elim q => [//| c' q' IH cae].
+have cae': close_alive_edges q' (e :: future_events).
+  move : cae.
+  by rewrite /close_alive_edges /all => /andP [] /andP [] _ _.
+move=> condition.
+rewrite /=.
+apply/andP; split; last first.
+  apply: IH=> //.
+  by move=> c cin; apply condition; rewrite inE cin orbT.
+move: cae; rewrite /= /end_edge_ext /= => /andP[] /andP[] /orP[].
+  move=> -> +; rewrite orTb=> /orP[].
+    by move=> ->.
+  move=> /orP [abs | ].
+  case: (condition c').
+    by rewrite inE eqxx.
+  by rewrite abs.
+  by move=> ->; rewrite orbT.
+  move=> /orP [abs | ].
+  case: (condition c').
+    by rewrite inE eqxx.
+  by rewrite abs.
+move=> ->; rewrite orbT.
+move=> /orP[] .
+    by move=> ->.
+  move=> /orP [abs | ].
+  case: (condition c').
+    by rewrite inE eqxx.
+  by rewrite abs.
+by move=> ->; rewrite orbT.
+Qed.
+
+Lemma valid_between_events g e p future :
+lexePt e p ->
+(forall e', e' \in future -> lexePt p (point e')) ->
+valid_edge g e -> inside_box p -> end_edge_ext g future ->
+valid_edge g p.
+Proof.
+move => einfp pinffut vale.
+rewrite /inside_box => /andP [] _ /andP [] botv topv.
+rewrite /end_edge => /orP [].
+  rewrite !inE /valid_edge/generic_trajectories.valid_edge.
+  by move=> /orP [] /eqP ->; rewrite !ltW;
+    move: botv topv=> /andP[] a b /andP[] c d; rewrite ?(a,b,c,d).
+move => /hasP [] e' e'in e'c.
+have pinfe' := pinffut e' e'in.
+rewrite /valid_edge; apply /andP; split.
+  move : vale.
+  rewrite /valid_edge => /andP [] ginfe _.
+  move : einfp.
+  rewrite /lexPt => /orP [esinfp | /andP [] /eqP <- //].
+  by rewrite ltW // (le_lt_trans ginfe esinfp).
+move : e'c.
+rewrite /event_close_edge => /eqP ->.
+move : pinfe'.
+rewrite /lexPt => /orP [ | /andP [] /eqP -> //].
+apply ltW .
+Qed.
+
+Lemma replacing_seq_adjacent l1 l2 fc lc :
+l1 != nil -> l2 != nil ->
+low (head dummy_cell l1) = low (head dummy_cell l2) ->
+high (last dummy_cell l1) = high (last dummy_cell l2) ->
+adjacent_cells (fc ++ l1 ++ lc) ->
+adjacent_cells l2 ->
+adjacent_cells (fc ++ l2 ++ lc).
+Proof.
+rewrite /adjacent_cells; case: fc => [ | a0 fc] /=; case: l1 => //=;
+   case: l2 => //=; move=> a2 l2 a1 l1 _ _ a1a2 l1l2.
+  rewrite cat_path => /andP[] pl1 plc pl2; rewrite cat_path pl2.
+  by move: plc; case: lc => [// | a3 l3 /=]; rewrite -l1l2.
+rewrite cat_path /= cat_path => /andP[] pfc /andP[] jfca1 /andP[] pl1 plc pl2.
+rewrite cat_path /= cat_path; rewrite pfc -a1a2 jfca1 pl2.
+by move: plc; case: lc => [// | a3 l3 /=]; rewrite -l1l2.
+Qed.
+
+Lemma replacing_seq_cells_bottom_top l1 l2 fc lc :
+  l1 != nil -> l2 != nil ->
+  low (head dummy_cell l1) = low (head dummy_cell l2) ->
+  high (last dummy_cell l1) = high (last dummy_cell l2) ->
+  cells_bottom_top (fc ++ l1 ++ lc) = cells_bottom_top (fc ++ l2 ++ lc).
+Proof.
+move=> l1n0 l2n0 hds tls.
+case: fc => [ | c1 fc]; case: lc => [ | c2 lc];
+   rewrite /cells_bottom_top /cells_low_e_top /= ?cats0.
+-  by rewrite l1n0 l2n0 hds tls.
+-  case : l1 l1n0 hds tls => [ // | c1 l1] _; case: l2 l2n0 => [ | c3 l2] //= _.
+   by move=> -> lts; rewrite !last_cat /=.
+- case: l1 l1n0 tls {hds} => [ | c1' l1] //= _; case: l2 l2n0 => [ | c2' l2] //.
+  by move=> _ /=; rewrite !last_cat /= => ->.
+by rewrite !last_cat /=.
+Qed.
+
+Definition all_edges cells events :=
+  cell_edges cells ++ events_to_edges events.
+
+Lemma mono_cell_edges s1 s2 : {subset s1 <= s2} ->
+  {subset cell_edges s1 <= cell_edges s2}.
+Proof.
+by move=> sub g; rewrite mem_cat => /orP[] /mapP[c cin geq];
+  rewrite /cell_edges geq mem_cat map_f ?orbT // sub.
+Qed.
+
+Lemma cell_edges_catC s1 s2 :
+  cell_edges (s1 ++ s2) =i cell_edges (s2 ++ s1).
+Proof.
+move=> g.
+by apply/idP/idP; apply: mono_cell_edges => {}g; rewrite !mem_cat orbC.
+Qed.
+
+Lemma cell_edges_cat (s1 s2 : seq cell) :
+  cell_edges (s1 ++ s2) =i cell_edges s1 ++ cell_edges s2.
+Proof.
+move=> g; rewrite /cell_edges !(mem_cat, map_cat) !orbA; congr (_ || _).
+by rewrite -!orbA; congr (_ || _); rewrite orbC.
+Qed.
+
+Lemma cell_edges_cons c s : cell_edges (c :: s) =i
+    (low c :: high c :: cell_edges s).
+Proof. by move=> g; rewrite -[c :: s]/([:: c] ++ s) cell_edges_cat. Qed.
+
+Lemma cell_edges_catCA s1 s2 s3 :
+  cell_edges (s1 ++ s2 ++ s3) =i cell_edges (s2 ++ s1 ++ s3).
+Proof.
+move=> g; rewrite 2!catA [in LHS]cell_edges_cat [in RHS]cell_edges_cat.
+rewrite [in LHS]mem_cat [in RHS]mem_cat; congr (_ || _).
+by rewrite cell_edges_catC.
+Qed.
+
+Definition cover_left_of p s1 s2 :=
+  forall q, inside_box q -> lexePt q p ->
+  has (inside_open' q) s1 || has (inside_closed' q) s2.
+
+Lemma contains_to_inside_open' open evs c p :
+  seq_valid open p -> close_alive_edges open evs ->
+  inside_box p ->
+  p_x (last dummy_pt (left_pts c)) < p_x p ->
+  all (lexePt p) [seq point e | e <- evs] ->
+  c \in open -> contains_point' p c -> inside_open' p c.
+Proof.
+rewrite inside_open'E /contains_point'.
+move=> val clae inbox_p leftb rightb cin /andP[] -> ->.
+rewrite leftb.
+have cledge g : (g \in [:: bottom; top]) || end_edge g evs ->
+        p_x p <= p_x (right_pt g).
+  have [/ltW pbot /ltW ptop] : p_x p < p_x (right_pt bottom) /\
+             p_x p < p_x (right_pt top).
+    by apply/andP; move:inbox_p=> /andP[] _ /andP[] /andP[] _ -> /andP[] _ ->.
+  move=>/orP[]; [by rewrite !inE => /orP[]/eqP -> | ].
+  move/hasP=> [ev' ev'in /eqP ->].
+  apply: lexePt_xW.
+  by apply/(allP rightb)/map_f.
+have /andP [cmp1 cmp2] : (p_x p <= p_x (right_pt (low c))) &&
+                (p_x p <= p_x (right_pt (high c))).
+  by apply/andP; split; apply/cledge; move/allP: clae=> /(_ _ cin)/andP[].
+rewrite /open_limit.
+by case: (ltrP (p_x (right_pt (low c))) (p_x (right_pt (high c))))=> //.
+Qed.
+
+Lemma contact_middle_at_point p cc s1 s2 c :
+  adjacent_cells cc ->
+  seq_valid cc p ->
+  all (contains_point p) cc ->
+  cc = s1 ++ c :: s2 ->
+  (s1 != nil -> p === low c) /\ (s2 != nil -> p === high c).
+Proof.
+move=> adj sv ctps dec.
+have cin : c \in cc by rewrite dec !(inE, mem_cat) eqxx ?orbT.
+have [vlc vhc] : valid_cell c p by move: (allP sv _ cin) => /andP.
+have /andP[plc phc] := (allP ctps _ cin).
+split.
+elim/last_ind: s1 dec => [// | s1 a _] dec _.
+  have /eqP ac : high a == low c.
+    case: s1 dec adj => [ | b s1] -> /=; first by move => /andP[] ->.
+    by rewrite cat_path last_rcons /= => /andP[] _ /andP[].
+  have ain : a \in cc by rewrite dec -cats1 !(mem_cat, inE) eqxx ?orbT.
+  apply: (under_above_on vlc _ plc).
+  by rewrite -ac; move: (allP ctps _ ain)=> /andP[].
+case: s2 dec => [// | a s2] + _.
+rewrite -[ c :: _]/([:: c] ++ _) catA => dec.
+have /eqP ca : high c == low a.
+  case: s1 dec adj => [ | b s1] -> /=; first by move=> /andP[] ->.
+  by rewrite cats1 cat_path last_rcons /= => /andP[] _/andP[].
+have ain : a \in cc by rewrite dec !(mem_cat, inE) eqxx ?orbT.
+apply: (under_above_on vhc phc).
+by rewrite ca; move: (allP ctps _ ain)=> /andP[].
+Qed.
+
+Definition strict_inside_open (p : pt) (c : cell) :=
+  (p <<< high c) && (~~(p <<= low c)) &&
+  (left_limit c < p_x p < open_limit c).
+
+Definition strict_inside_closed (p : pt) (c : cell) :=
+  (p <<< high c) && (~~(p <<= low c)) &&
+  (left_limit c < p_x p < right_limit c).
+
+Definition o_disjoint (c1 c2 : cell) :=
+  forall p, ~~(inside_open' p c1 && inside_open' p c2).
+
+Definition o_disjoint_e (c1 c2 : cell) :=
+  c1 = c2 \/ o_disjoint c1 c2.
+
+Lemma o_disjointC c1 c2 : o_disjoint c1 c2 -> o_disjoint c2 c1.
+Proof. by move=> c1c2 p; rewrite andbC; apply: c1c2. Qed.
+
+Definition disjoint_open_cells :=
+  forall c1 c2 : cell, o_disjoint_e c1 c2.
+
+
+Lemma seq_edge_below s c :
+  adjacent_cells (rcons s c) -> s_right_form (rcons s c) ->
+  path (@edge_below R) (head dummy_edge [seq low i | i <- rcons s c])
+     [seq high i | i <- rcons s c].
+Proof.
+elim: s => [ | c0 s Ih] // /[dup]/= /adjacent_cons adj' adj /andP[] rfc rfo.
+apply/andP;split;[exact: rfc | ].
+have -> : high c0 = head dummy_edge [seq low i | i <- rcons s c].
+  by move: adj; case: (s) => [ | c1 q]; rewrite //= => /andP[] /eqP -> _.
+by apply: Ih.
+Qed.
+
+Lemma seq_edge_below' s :
+  adjacent_cells s -> s_right_form s ->
+  path (@edge_below R) (head dummy_edge [seq low i | i <- s])
+     [seq high i | i <- s].
+Proof.
+elim: s => [ | c0 s Ih] // /[dup]/= /adjacent_cons adj' adj /andP[] rfc rfo.
+apply/andP;split;[exact: rfc | ].
+case sq : s => [// | c1 s'].
+have -> : high c0 = head dummy_edge [seq low i | i <- c1 :: s'].
+  by move: adj; rewrite sq /= => /andP[] /eqP.
+by rewrite -sq; apply: Ih.
+Qed.
+
+Lemma below_seq_higher_edge_aux s g e p  :
+  {in rcons s g & &, transitive (@edge_below R)} ->
+  all (fun g' => valid_edge g' p) (rcons s g) ->
+  sorted (@edge_below R) (rcons s g) ->
+  all (fun g' => valid_edge g' e) (rcons s g) ->
+  {in rcons s g &, no_crossing R} ->
+  {in rcons s g, forall g', p <<< g' -> p <<< g}.
+Proof.
+elim: s => [ | g0 s Ih].
+  rewrite /=?andbT => /= _ _ _ sval noc g1.
+  by rewrite inE=> /eqP ->.
+rewrite -[rcons _ _]/(g0 :: rcons s g)=> e_trans svp.
+move/[dup]/path_sorted=> adj' adj /= sval noc.
+move=> g1 g1in puc1.
+have v0p : valid_edge g0 p by apply: (allP svp); rewrite inE eqxx.
+have vedge g2 : g2 \in rcons s g -> valid_edge g2 p.
+  by move=> g2in; apply: (allP svp); rewrite inE g2in orbT.
+have vgp : valid_edge g p by apply: vedge; rewrite mem_rcons inE eqxx.
+have g0below : g0 <| g.
+  move: adj; rewrite /= (path_sorted_inE e_trans); last by apply/allP.
+  by move=> /andP[]/allP + _; apply; rewrite mem_rcons inE eqxx.
+move:g1in; rewrite /= inE => /orP[/eqP g1g0 | intail].
+  by apply: (order_edges_strict_viz_point' v0p vgp g0below); rewrite -g1g0.
+have tr' : {in rcons s g & &, transitive (@edge_below R)}.
+  move=> g1' g2' g3' g1in g2in g3in.
+  by apply: e_trans; rewrite inE ?g1in ?g2in ?g3in orbT.
+have svp' : all (fun x => valid_edge x p) (rcons s g) by case/andP: svp.
+have sval' : all (fun x => valid_edge x e) (rcons s g) by case/andP: sval.
+have noc' : {in rcons s g &, no_crossing R}.
+  by move=> g1' g2' g1in g2in; apply: noc; rewrite !inE ?g1in ?g2in orbT.
+by apply: (Ih tr' svp' adj' sval' noc' g1 intail puc1).
+Qed.
+
+Definition open_cell_side_limit_ok c :=
+  [&& left_pts c != [::] :> seq pt,
+   all (fun (p : pt) => p_x p == left_limit c) (left_pts c),
+  sorted >%R [seq p_y p | p <- left_pts c],
+  (head dummy_pt (left_pts c) === high c) &
+  (last dummy_pt (left_pts c) === low c)].
+
+Lemma strict_inside_open_valid c (p : pt) :
+  open_cell_side_limit_ok c ->
+  strict_inside_open p  c ->
+  valid_edge (low c) p && valid_edge (high c) p.
+Proof.
+move=> /andP[]; rewrite /strict_inside_open /left_limit /open_limit.
+case: (left_pts c) => [// | w tl _] /andP[] allxl /andP[] _ /andP[].
+rewrite /=; move=> /andP[] _ /andP[] lh _ /andP[] _ /andP[] ll _.
+move=> /andP[] _ /andP[] ls rs.
+rewrite /valid_edge/generic_trajectories.valid_edge ltW; last first.
+  by apply: (le_lt_trans ll).
+rewrite ltW; last first.
+  apply: (lt_le_trans rs).
+  by case: (lerP (p_x (right_pt (low c))) (p_x (right_pt (high c)))) => // /ltW.
+rewrite ltW; last first.
+  apply: (le_lt_trans lh).
+  by rewrite (eqP (allP allxl w _)) //= inE eqxx.
+apply: ltW.
+apply: (lt_le_trans rs).
+by case: (lerP (p_x (right_pt (low c))) (p_x (right_pt (high c)))) => // /ltW.
+Qed.
+
+Lemma valid_high_limits c p :
+  open_cell_side_limit_ok c ->
+  left_limit c < p_x p <= open_limit c -> valid_edge (high c) p.
+Proof.
+move=>/andP[] wn0 /andP[] /allP allx /andP[] _ /andP[] /andP[] _ /andP[] + _ _.
+rewrite (eqP (allx _ (head_in_not_nil _ wn0))) // => onh.
+rewrite /left_limit=> /andP[] /ltW llim.
+rewrite /valid_edge/generic_trajectories.valid_edge (le_trans onh llim) /=.
+rewrite /open_limit.
+case: (lerP (p_x (right_pt (low c))) (p_x (right_pt (high c))))=> // /[swap].
+by apply: le_trans.
+Qed.
+
+Lemma valid_low_limits c p :
+  open_cell_side_limit_ok c ->
+  left_limit c < p_x p <= open_limit c -> valid_edge (low c) p.
+Proof.
+move=>/andP[] wn0 /andP[] /allP ax /andP[] _ /andP[] _ /andP[] _ /andP[] onl _.
+rewrite /left_limit=> /andP[] /ltW llim.
+rewrite /valid_edge/generic_trajectories.valid_edge (le_trans onl llim) /=.
+rewrite /open_limit.
+case: (lerP (p_x (right_pt (low c))) (p_x (right_pt (high c))))=> // /[swap].
+by move=> ph hl; apply/ltW/(le_lt_trans ph hl).
+Qed.
+
+Lemma inside_openP p c :
+  open_cell_side_limit_ok c ->
+  strict_inside_open p c =
+  [&& inside_open' p c, p_x p < open_limit c & p <<< high c].
+Proof.
+move=> cok.
+rewrite /strict_inside_open/inside_open'/inside_open_cell contains_pointE.
+have [pin | ] := boolP (left_limit c < p_x p <= open_limit c); last first.
+  rewrite (lt_neqAle _ (open_limit _)).
+  by rewrite negb_and => /orP[] /negbTE /[dup] A ->; rewrite !andbF.
+have vh : valid_edge (high c) p.
+  by move: (pin) => /(valid_high_limits cok).
+have vl : valid_edge (low c) p.
+  by move: (pin) => /(valid_low_limits cok).
+rewrite [in RHS](under_onVstrict) // [in RHS] strict_nonAunder // negb_and.
+rewrite !le_eqVlt !negbK.
+by have [uh //= | nuh] := boolP(p <<< high c);
+  have [al //= | nal] := boolP(p >>> low c);
+  have [lfp | nlfp] := boolP (left_limit c < p_x p);
+  have [rhp | nrhp] := boolP (p_x p < open_limit c);
+      rewrite ?orbT ?andbT ?orbF ?andbF.
+Qed.
+
+Lemma below_seq_higher_edge s c e p :
+  {in [seq high i | i <- rcons s c] & & ,transitive (@edge_below R)} ->
+  adjacent_cells (rcons s c) -> s_right_form (rcons s c) -> 
+  seq_valid (rcons s c) e -> 
+  {in [seq high i | i <- rcons s c] &, no_crossing R} ->
+  {in rcons s c, forall g, open_cell_side_limit_ok g} ->
+  {in rcons s c, forall c1, strict_inside_open p c1 ->
+                 valid_edge (high c) p-> p <<< high c}.
+Proof.
+move=> e_trans adj rf sval noc csok c1 c1in /[dup]/andP[] /andP[] puc1 _ pp2.
+move=> inpc1.
+set g := high c => vgp.
+set sg := [seq high i | i <- s & valid_edge (high i) p].
+have subp : {subset rcons sg g <= [seq high i | i <- rcons s c]}.
+  move=> g1; rewrite map_rcons 2!mem_rcons 2!inE=>/orP[-> //| ].
+  rewrite /sg=> /mapP[c1' + c1'eq]; rewrite mem_filter=>/andP[] _ c1'in.
+  by apply/orP; right; apply/mapP; exists c1'.
+have e_trans' : {in rcons sg g & &, transitive (@edge_below R)}.
+  move=> g1 g2 g3 g1in g2in g3in.
+  by apply: e_trans; apply: subp.
+have svp : all (fun g' => valid_edge g' p) (rcons sg g).
+  apply/allP=> g'; rewrite -map_rcons => /mapP [c' + ->].
+  by rewrite mem_rcons inE mem_filter => /orP[/eqP -> |  /andP[] + _].
+have adj' : sorted (@edge_below R) (rcons sg g).
+  have sggq : rcons sg g =
+             [seq i  <- [seq high j | j <- rcons s c] | valid_edge i p].
+     by rewrite (@filter_map _ _ high) filter_rcons /= vgp map_rcons.
+  rewrite sggq.
+  apply: (sorted_filter_in e_trans).
+    apply/allP=> g1 /mapP[c' + g'eq]. 
+    rewrite topredE !mem_rcons !inE.
+    rewrite /g=>/orP[/eqP <- | c'in].
+      by rewrite map_rcons mem_rcons inE g'eq eqxx.
+    by rewrite map_rcons mem_rcons inE; apply/orP/or_intror/mapP; exists c'.
+  have := seq_edge_below' adj rf.
+  by case s_eq : s => [ // | a s' /=] /andP[] _.
+have noc' : {in rcons sg g &, no_crossing R}.
+  by move=> g1 g2 /subp g1in /subp g2in;  apply: noc.
+apply: (below_seq_higher_edge_aux e_trans' svp adj' svp noc' _ puc1).
+rewrite -map_rcons; apply/mapP; exists c1 => //.
+move: c1in; rewrite !mem_rcons !inE=>/orP[-> // | c1in].
+rewrite mem_filter c1in andbT; apply/orP/or_intror.
+apply: (proj2 (andP (strict_inside_open_valid _ inpc1))).
+by apply: csok; rewrite mem_rcons inE c1in orbT.
+Qed.
+
+Lemma left_side_below_seq_higher_edge s c e p :
+  adjacent_cells (rcons s c) -> s_right_form (rcons s c) ->
+  seq_valid (rcons s c) e ->
+  {in [seq high i | i <- rcons s c], forall g, p_x (left_pt g) < p_x e} ->
+  {in [seq high i | i <- rcons s c] &, no_crossing R} ->
+  {in rcons s c, forall c1, open_cell_side_limit_ok c1} ->
+  {in rcons s c, forall c1, strict_inside_open p c1 ->
+        valid_edge (high c) p -> p <<< high c}.
+Proof.
+move => adj rfs svals llim noc csok.
+apply: (below_seq_higher_edge _ adj rfs svals) => //.
+have vale' : {in [seq high i | i <- rcons s c], forall g, valid_edge g e}.
+  by apply: seq_valid_high.
+apply: (edge_below_trans _ vale' noc); right; exact: llim.
+Qed.
+
+Lemma right_side_below_seq_higher_edge s c e p :
+  adjacent_cells (rcons s c) -> s_right_form (rcons s c) -> 
+  seq_valid (rcons s c) e ->
+  {in [seq high i | i <- rcons s c], forall g, p_x e < p_x (right_pt g)} ->
+  {in [seq high i | i <- rcons s c] &, no_crossing R} ->
+  {in rcons s c, forall c1, open_cell_side_limit_ok c1} ->
+  {in rcons s c, forall c1, strict_inside_open p c1 -> 
+      valid_edge (high c) p -> p <<< high c}.
+Proof.
+move => adj rfs svals rlim noc csok.
+apply: (below_seq_higher_edge _  adj rfs svals) => //.
+have vale' : {in [seq high i | i <- rcons s c], forall g, valid_edge g e}.
+  by apply: seq_valid_high.
+apply: (edge_below_trans _ vale' noc); left; exact: rlim.
+Qed.
+
+Lemma o_disjoint_eC (c1 c2 : cell) :
+  o_disjoint_e c1 c2 -> o_disjoint_e c2 c1.
+Proof.
+move=> [-> // |]; first by left.
+by move=> disj; right=> p; rewrite andbC; apply: disj.
+Qed.
+
+Definition closed_cell_side_limit_ok c :=
+ [&& left_pts c != [::] :> seq pt,
+   all (fun p : pt => p_x p == left_limit c) (left_pts c),
+   sorted >%R [seq p_y p | p <- left_pts c],
+   head dummy_pt (left_pts c) === high c,
+   last dummy_pt (left_pts c) === low c,
+    right_pts c != [::] :> seq pt,
+   all (fun p : pt => p_x p == right_limit c) (right_pts c),
+   sorted <%R [seq p_y p | p <- right_pts c],
+   head dummy_pt (right_pts c) === low c &
+   last dummy_pt (right_pts c) === high c].
+
+Lemma closed_right_imp_open c:
+  closed_cell_side_limit_ok c -> right_limit c <= open_limit c.
+Proof.
+move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+move=> /andP[] ln0 /andP[] eqs /andP[] _ /andP[] /andP[] _ /andP[] _ /[swap].
+move=> /andP[] _ /andP[] _.
+rewrite (eqP (allP eqs (head dummy_pt (right_pts c)) (head_in_not_nil _ ln0))).
+rewrite /right_limit /open_limit.
+by case : (lerP (p_x (right_pt (low c))) (p_x (right_pt (high c)))).
+Qed.
+
+Definition any_edge (b : bool) (c : cell) : edge :=
+  if b then low c else high c.
+
+(* This is not used (yet?) *)
+Lemma fc_lc_right_pt s ev events :
+  close_alive_edges s events ->
+  inside_box (point ev) ->
+  all (fun x => lexPtEv  ev x) events ->
+  {in s, forall c b, lexPt (point ev) (right_pt (any_edge b c))}.
+Proof.
+move=> /allP clae inbox_e /allP lexev c cin b.
+have : ((any_edge b c) \in [:: bottom; top]) || end_edge (any_edge b c) events.
+  by have := clae _ cin; rewrite /end_edge /any_edge; case: b=> /= /andP[].
+move=> /orP[ | ].
+  move: inbox_e => /andP[] _ /andP[]/andP[] _ botP /andP[] _ topP.
+  by rewrite !inE => /orP[]/eqP ->; rewrite /lexPt ?botP ?topP.
+by move=>/hasP[ev' ev'in /eqP ->]; apply: lexev.
+Qed.
+
+Lemma seq_low_high_shift s :
+  s != nil ->  adjacent_cells s ->
+  rcons [seq low i | i <- s] (high (last dummy_cell s)) =
+  (low (head dummy_cell s) :: [seq high i | i <- s]).
+Proof.
+elim: s => [ // | c s +] _ /=.
+  case: s => [// | c' s].
+rewrite /=; move=> /(_ isT) Ih => /andP[] /eqP -> adj; congr (_ :: _).
+by apply: Ih.
+Qed.
+
+Lemma cell_edges_high s :
+  s != [::] -> adjacent_cells s ->
+  cell_edges s =i low (head dummy_cell s) :: [seq high i | i <- s].
+Proof.
+move=> sn0 adj g; rewrite mem_cat; apply/idP/idP.
+  move=>/orP[].
+    by rewrite -(seq_low_high_shift sn0 adj) mem_rcons inE orbC => ->.
+  by rewrite inE orbC => ->.
+rewrite inE => /orP[/eqP -> | ].
+  by rewrite map_f // head_in_not_nil.
+by move=> ->; rewrite orbT.
+Qed.
+
+Lemma pvert_y_bottom p : inside_box p -> pvert_y p bottom < p_y p.
+Proof.
+have tmp : bottom \in [:: bottom; top] by rewrite inE eqxx.
+move=> /[dup]/inside_box_valid_bottom_top=> /(_ _ tmp) val. 
+move=> /andP[] /andP[] + _ _.
+by rewrite (under_pvert_y val) -ltNge.
+Qed.
+
+Lemma adjacent_right_form_sorted_le_y s p :
+    seq_valid s p ->
+    adjacent_cells s ->
+    s_right_form s ->
+    sorted <=%R [seq pvert_y p (high c) | c <- s].
+Proof.
+elim: s => [ // | a s Ih] /=.
+move=> /andP[] _ vs /[dup]/adjacent_cons adj + /andP[] _ rfs.
+case s_eq : s => [ // | b s'] /= /andP[]/eqP hl _.
+rewrite hl.
+have bin : b \in s by rewrite s_eq inE eqxx.
+have rfb := (allP rfs b bin).
+have := (allP vs b bin)=> /andP[] vl vh.
+have := order_below_viz_vertical vl vh.
+rewrite (pvertE vl) (pvertE vh) => /(_ _ _ erefl erefl rfb) /= => -> /=.
+by move: Ih; rewrite s_eq; apply; rewrite -s_eq.
+Qed.
+
+Definition edge_side_prop (ev : event) (g : edge) :=
+        if valid_edge g (point ev) then
+          if pvert_y (point ev) g < p_y (point ev) then
+             p_x (point ev) < p_x (right_pt g)
+          else
+             if p_y (point ev) < pvert_y (point ev) g then
+             p_x (left_pt g) < p_x (point ev)
+             else
+           true
+        else
+          true.
+
+Definition edge_side (evs : seq event) (open : seq cell) :=
+  if evs is ev :: _ then
+    all (edge_side_prop ev) [seq high c | c <- open]
+  else true.
+
+Definition extra_bot := Bcell nil nil bottom bottom.
+
+Definition oc_disjoint (c1 c2 : cell) :=
+  forall p, ~~ (inside_open' p c1 && inside_closed' p c2).
+
+Definition disjoint_open_closed_cells :=
+  forall c1 c2, oc_disjoint c1 c2.
+
+Definition c_disjoint (c1 c2 : cell) :=
+  forall p, ~~ (inside_closed' p c1 && inside_closed' p c2).
+
+Lemma c_disjointC (c1 c2 : cell) :
+  c_disjoint c1 c2 -> c_disjoint c2 c1.
+Proof. by move=> cnd p; rewrite andbC; apply: cnd. Qed.
+
+Definition c_disjoint_e (c1 c2 : cell) :=
+  c1 = c2 \/ c_disjoint c1 c2.
+
+Lemma c_disjoint_eC (c1 c2 : cell) :
+  c_disjoint_e c1 c2 -> c_disjoint_e c2 c1.
+Proof.
+move=> cnd; have [/eqP -> | c1nc2] := boolP(c1 == c2).
+  by left.
+case: cnd => [/eqP | cnd ]; first by rewrite (negbTE c1nc2).
+by right; apply: c_disjointC.
+Qed.
+
+Definition disjoint_closed_cells :=
+  forall c1 c2, c_disjoint_e c1 c2.
+
+Definition pt_at_end (p : pt) (e : edge) :=
+  p === e -> p \in [:: left_pt e; right_pt e].
+
+Definition connect_limits (s : seq cell) :=
+  sorted [rel c1 c2 | right_limit c1 == left_limit c2] s.
+
+Definition edge_covered (e : edge) (os : seq cell) (cs : seq cell) :=
+  (exists (opc : cell) (pcc : seq cell), {subset pcc <= cs} /\
+    {in rcons pcc opc, forall c, high c = e} /\
+    connect_limits (rcons pcc opc) /\
+    opc \in os /\
+    left_limit (head_cell (rcons pcc opc)) = p_x (left_pt e)) \/
+  (exists pcc, pcc != [::] /\ 
+    {subset pcc <= cs} /\
+    {in pcc, forall c, high c = e} /\
+    connect_limits pcc /\
+    left_limit (head_cell pcc) = p_x (left_pt e) /\
+    right_limit (last_cell pcc) = p_x (right_pt e)).
+
+Lemma connect_limits_rcons (s : seq cell) (lc : cell) :
+  s != nil -> connect_limits (rcons s lc) =
+   connect_limits s && (right_limit (last dummy_cell s) == left_limit lc).
+Proof.
+elim: s => [// | c0 s Ih] _ /=.
+by rewrite rcons_path.
+Qed.
+
+Lemma left_limit_max c:
+  open_cell_side_limit_ok c ->
+  max (p_x (left_pt (high c))) (p_x (left_pt (low c))) <= left_limit c.
+Proof.
+move=>/andP[] + /andP[] + /andP[] _ /andP[] /andP[] _ + /andP[] _ +.
+rewrite /left_limit ge_max.
+case: (left_pts c) => [ // | p tl] /=.
+by move => _ /andP[] /eqP +  _ /andP[] + _ /andP[] + _ => <- -> ->.
+Qed.
+
+Lemma bottom_left_x c : left_limit c = p_x (bottom_left_corner c).
+Proof. by[]. Qed.
+
+Lemma bottom_left_lex_to_high s p:
+cells_bottom_top s ->
+adjacent_cells s ->
+s_right_form s ->
+all open_cell_side_limit_ok s ->
+inside_box p ->
+bottom_left_cells_lex s p ->
+{in s, forall c, lexPt (left_pt (high c)) p}.
+Proof.
+move=> cbtom adj rfo sok inboxp btm_left c cin.
+have /mem_seq_split [s1 [s2 s12q]] := cin.
+case s2q : s2 => [ | c' s2'].
+   move: cbtom=> /andP[] /andP[] _ _; rewrite s12q s2q last_cat /=.
+   move=> /eqP ctop.
+   move: inboxp=> /andP[] _ /andP[] _ /andP[] + _.
+   by rewrite /lexPt ctop=> ->.
+have c'in : c' \in s.
+  by rewrite s12q s2q !mem_cat !inE eqxx ?orbT.
+move: adj; rewrite s12q s2q=> /adjacent_catW[] _ /= /andP[] /eqP cc' _.
+have c'ok : open_cell_side_limit_ok c'.
+  by apply: (allP sok c').
+have lexbtme := btm_left c' c'in.
+have btmon : bottom_left_corner c' === low c'.
+  by move: c'ok=> /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+have := lexePt_lexPt_trans (on_edge_lexePt_left_pt btmon) lexbtme.
+by rewrite cc'.
+Qed.
+
+Lemma inside_box_valid_bottom x : inside_box x -> valid_edge bottom x.
+Proof.
+move=> /andP[] _ /andP[] /andP[] /ltW + /ltW + _.
+rewrite /valid_edge/generic_trajectories.valid_edge.
+by move=> -> ->.
+Qed.
+
+Section open_cells_decomposition.
+
+Variables open fc cc : seq cell.
+Variable lcc : cell.
+Variable lc : seq cell.
+Variable p : pt.
+
+Hypothesis cbtom : cells_bottom_top open.
+Hypothesis adj : adjacent_cells open.
+Hypothesis rfo : s_right_form open.
+Hypothesis sval : seq_valid open p.
+Hypothesis inbox_p : between_edges bottom top p.
+
+Hypothesis ocd : open = fc ++ cc ++ lcc :: lc.
+Hypothesis allnct : {in fc, forall c, ~~ contains_point p c}.
+Hypothesis allct : {in cc, forall c, contains_point p c}.
+Hypothesis lcc_ctn : contains_point p lcc.
+Hypothesis head_nct : lc != [::] -> ~~ contains_point p (head lcc lc).
+Hypothesis noc : {in cell_edges open &, no_crossing R}.
+
+Let le := low (head lcc cc).
+Let he := high lcc.
+
+#[clearbody]
+Let headin : head lcc cc \in open.
+Proof.
+by rewrite ocd; case: cc => [ | a cc'] /=; rewrite !(mem_cat, inE) eqxx ?orbT.
+Defined.
+
+#[clearbody]
+Let vle : valid_edge le p.  
+Proof. by have /andP[] := (allP sval _ headin). Defined.
+
+#[clearbody]
+Let lccin : lcc \in open.
+Proof. by rewrite ocd !(mem_cat, inE) eqxx !orbT. Defined.
+
+#[clearbody]
+Let lein : le \in cell_edges open.
+Proof. by rewrite mem_cat /le map_f // headin. Defined.
+
+#[clearbody]
+Let hein : he \in cell_edges open.
+Proof. by rewrite mem_cat /he map_f ?orbT // lccin. Defined.
+
+#[clearbody]
+Let vhe : valid_edge he p.
+Proof. by have /andP[] := (allP sval _ lccin). Defined.
+
+#[clearbody]
+Let pal : p >>> le.
+Proof.
+elim/last_ind : {-1}(fc) (erefl fc) => [ | fc' c1 _] fc_eq.
+  suff -> : le = bottom.
+    by move: inbox_p=> /andP[].
+  move: cbtom=> /andP[] /andP[] _ /eqP <- _; rewrite ocd fc_eq /le.
+  by case: (cc).
+have c1in : c1 \in open.
+  by rewrite ocd fc_eq !(mem_cat, mem_rcons, inE) eqxx.
+have /andP[vlc1 vhc1] : valid_edge (low c1) p && valid_edge (high c1) p.
+  by apply: (allP sval).
+have /order_edges_strict_viz_point' : low c1 <| high c1 by apply: (allP rfo).
+move=> /(_ _ vlc1 vhc1) oc1.
+have ctfc : contains_point p (head lcc cc).
+  case cc_eq : (cc) => [ // | c2 cc'].
+  by apply: allct; rewrite /= cc_eq inE eqxx.
+have hc1q : high c1 = low (head lcc cc).
+  move: adj; rewrite ocd fc_eq -cats1 -!catA=> /adjacent_catW[] _ /=.
+  by case: (cc) => [ | ? ?] /= /andP[] /eqP.
+have palc1 : p >>= low c1.
+  apply/negP=> /oc1 abs.  
+  by move: ctfc; rewrite contains_pointE -hc1q abs.
+have nctc1 : ~~ contains_point p c1.
+  by apply: allnct; rewrite fc_eq mem_rcons inE eqxx.
+by move: nctc1; rewrite contains_pointE palc1 /= hc1q.
+Defined.
+
+#[clearbody]
+Let puh : p <<< he.
+Proof.
+case lc_eq : lc => [ | c1 lc'].
+  move: inbox_p => /andP[] _ +.
+  by case/andP : cbtom=> _; rewrite ocd lc_eq !last_cat /= /he => /eqP ->.
+have c1in : c1 \in open.
+  by rewrite ocd lc_eq /= !(mem_cat, inE) eqxx !orbT.
+have /andP[vlc1 vhc1] : valid_edge (low c1) p && valid_edge (high c1) p.
+  by apply: (allP sval).
+have /order_edges_viz_point' := allP rfo _ c1in => /(_ _ vlc1 vhc1) oc1.
+have hlcclc1 : high lcc = low c1.
+  move: adj; rewrite ocd lc_eq=> /adjacent_catW[] _ /adjacent_catW[] _.
+  by move=> /andP[] /eqP.
+have pulc1 : p <<= low c1.
+  by rewrite -hlcclc1; move: lcc_ctn => /andP[].
+move: head_nct; rewrite lc_eq /= contains_pointE negb_and.
+rewrite (oc1 pulc1) orbF negbK -hlcclc1.
+by apply.
+Defined.
+
+Lemma fclc_not_contain c : (c \in fc) || (c \in lc) ->
+  ~~ contains_point p c.
+Proof.
+move=> /orP[ | cl]; first by apply: allnct.
+case lc_eq : lc => [ | c2 lc']; first by move: cl; rewrite lc_eq.
+have adjlc : adjacent_cells (lcc :: lc).
+  by move: adj; rewrite ocd => /adjacent_catW[] _ /adjacent_catW[].
+have adjlc' : adjacent_cells (c2 :: lc').
+  by move: adjlc; rewrite lc_eq=> /andP[] _.
+have sval' : seq_valid (c2 :: lc') p.
+  apply/allP=> x xin; apply: (allP sval); rewrite ocd !(mem_cat, inE).
+  by rewrite lc_eq xin !orbT.
+have lc2_eq : low c2 = he.
+  by move: adjlc; rewrite lc_eq /= /he => /andP[] /eqP ->.
+have rfolc : s_right_form (c2 :: lc').
+  apply/allP=> x xin; apply: (allP rfo).
+  by  rewrite ocd !mem_cat inE lc_eq xin ?orbT.
+have pulc2 : p <<< low c2 by rewrite lc2_eq.
+move: cl; rewrite lc_eq inE => /orP[/eqP -> | cinlc' ].
+  by apply/negP; rewrite contains_pointE pulc2.
+have pulc : p <<< low c.
+  by apply: (strict_under_seq adjlc' sval' rfolc pulc2 cinlc').
+by apply/negP; rewrite contains_pointE pulc.
+Qed.
+
+Lemma above_all_cells (s : seq cell) :
+  seq_valid s p ->
+  adjacent_cells s ->
+  s_right_form s ->
+  p >>> high (last dummy_cell s) ->
+  p >>> low (head dummy_cell s) /\ {in s, forall c, p >>> high c}.
+Proof.
+elim: s => [ | c0 s Ih]; first by move=> _ _ _ ->.
+move=> /= /andP[] /andP[] vl0 vh0 svals adjs /andP[] lbh rfos pah.
+have pal0 : p >>> high c0 -> p >>> low c0.
+  move=> {}pah.
+  rewrite under_pvert_y // -ltNge.
+  apply: (le_lt_trans (edge_below_pvert_y vl0 vh0 lbh)).
+  by rewrite ltNge -under_pvert_y.
+elim/last_ind : {-1}s (erefl s) svals adjs rfos pah => [ | s' c1 _]
+  /= s_eq svals adjs rfos pah.
+  split; last by move=> x; rewrite inE => /eqP ->.
+  by apply: pal0.
+have adjs1 : adjacent_cells (rcons s' c1) by apply: (path_sorted adjs).
+rewrite last_rcons in pah.
+rewrite s_eq last_rcons in Ih; have := Ih svals adjs1 rfos pah.
+move=> [] palh {}Ih.
+have hc0q : high c0 = low (head dummy_cell (rcons s' c1)).
+  by move: adjs; case: (s') => [ | ? ?] /= /andP[] /eqP.
+split; first by apply pal0; rewrite hc0q.
+move=> x; rewrite inE=> /orP[ /eqP -> |]; last by apply: Ih.
+by rewrite hc0q.
+Qed.
+
+Lemma below_all_cells (s : seq cell) :
+  seq_valid s p ->
+  adjacent_cells s ->
+  s_right_form s ->
+  p <<< low (head dummy_cell s) -> {in s, forall c, p <<< high c}.
+Proof.
+elim: s => [ | c0 s Ih]; first by [].
+move=> /= /andP[] /andP[] vl0 vh0 svals adjs /andP[] lbh rfos pah.
+have puh0 : p <<< low c0 -> p <<< high c0.
+  move=> {}pul.
+  rewrite strict_under_pvert_y //.
+  apply: (lt_le_trans _ (edge_below_pvert_y vl0 vh0 lbh)).
+  by rewrite -strict_under_pvert_y.
+have adjs1 : adjacent_cells s by apply: (path_sorted adjs).
+move=> x; rewrite inE => /orP[/eqP -> | ]; first by apply: puh0.
+case s_eq: s => [ // | c1 s'].
+have h0lc1 : high c0 = low c1 by move: adjs; rewrite s_eq /= => /andP[] /eqP.
+by rewrite -s_eq; apply: (Ih) => //; rewrite s_eq /= -h0lc1 (puh0 pah).
+Qed.
+
+Lemma connect_properties :
+  [/\ p >>> le, p <<< he, valid_edge le p, valid_edge he p &
+    forall c, (c \in fc) || (c \in lc) -> ~~contains_point p c].
+Proof. by split; last exact fclc_not_contain. Qed.
+
+Lemma fclc_not_end_aux c e :
+  point e = p ->
+  (c \in fc) || (c \in lc) -> 
+  (~ event_close_edge (low c) e) /\ (~ event_close_edge (high c) e).
+Proof.
+move=> pq /[dup] cin /fclc_not_contain/negP.
+have cino : c \in open.
+  by rewrite ocd !(mem_cat, inE); move:cin=> /orP[] ->; rewrite ?orbT.
+rewrite -pq=>/contrapositive_close_imp_cont; apply.
+  by apply: (allP rfo).
+by rewrite pq; apply/andP/(allP sval).
+Qed.
+
+Lemma low_under_high : le <| he.
+Proof.
+have [// | abs_he_under_le] := noc lein hein; case/negP: pal.
+by have /underW := (order_edges_strict_viz_point' vhe vle abs_he_under_le puh).
+Qed.
+
+Lemma in_cc_on_high c : c \in cc -> p === high c.
+Proof.
+move=> cin.
+have cino : c \in open by rewrite ocd !mem_cat cin !orbT.
+have vhc : valid_edge (high c) p by apply/(seq_valid_high sval)/map_f.
+apply: under_above_on => //; first by apply: (proj2 (andP (allct cin))).
+have [s1 [[ | c2 s2] cceq]] := mem_seq_split cin.
+  move: adj; rewrite ocd cceq -catA /= => /adjacent_catW[] _ /adjacent_catW[].
+  move=> _ /= /andP[] /eqP -> _.
+  by move: lcc_ctn=> /andP[].
+have c2in : c2 \in cc by rewrite cceq !(mem_cat, inE) eqxx !orbT.
+move: adj; rewrite ocd cceq -!catA; do 2 move => /adjacent_catW[] _.
+rewrite /= => /andP[] /eqP -> _.
+by apply: (proj1 (andP (allct c2in))).
+Qed.
+
+End open_cells_decomposition.
+
+Lemma inside_open_cell_valid c p1 : 
+  open_cell_side_limit_ok c ->
+  inside_open_cell p1 c -> 
+  valid_edge (low c) p1 && valid_edge (high c) p1.
+Proof.
+move=> /andP[] ne /andP[] sxl /andP[] _ /andP[] /andP[] _ onh /andP[] _ onl.
+move=> /andP[] _; rewrite /left_limit /open_limit=> /andP[] ge lemin.
+apply/andP; split.
+  apply/andP; split.
+    by apply: le_trans ge; move: onl=> /andP[].
+  apply: (le_trans lemin).
+  by rewrite ge_min lexx.
+apply/andP; split.
+ apply: le_trans ge; move: onh=> /andP[].
+ rewrite (eqP (allP sxl (head dummy_pt (left_pts c))_)) //.
+ by apply: head_in_not_nil.
+by rewrite le_min in lemin; move: lemin=>/andP[].
+Qed.
+
+End proof_environment.
+
+
+End working_environment.
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
new file mode 100644
index 0000000..964b7f9
--- /dev/null
+++ b/theories/cells_alg.v
@@ -0,0 +1,6955 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import generic_trajectories.
+Require Import math_comp_complements points_and_edges events cells.
+Require Import opening_cells.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section working_environment.
+
+Variable R : realFieldType.
+
+Notation pt := (pt R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+Notation Bpt := (Bpt R).
+Notation edge := (edge R).
+Notation event := (event R edge).
+Notation outgoing := (outgoing R edge).
+Notation point := (point R edge).
+
+Notation cell := (cell R edge).
+
+Notation dummy_pt := (dummy_pt R 1).
+Notation dummy_edge := (dummy_edge R 1 edge (@unsafe_Bedge R)).
+Notation dummy_cell := (dummy_cell R 1 edge (@unsafe_Bedge _)).
+Notation dummy_event := (dummy_event R 1 edge).
+
+Definition open_cells_decomposition_contact :=
+  open_cells_decomposition_contact R eq_op le +%R (fun x y => x - y) *%R 1
+    edge (@left_pt R) (@right_pt R).
+
+Definition open_cells_decomposition_rec :=
+  open_cells_decomposition_rec R eq_op le +%R (fun x y => x - y) *%R 1
+  edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Definition open_cells_decomposition :=
+  open_cells_decomposition R eq_op le +%R (fun x y => x - y) *%R 1
+  edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Notation scan_state := (scan_state R edge).
+Notation sc_open1 := (sc_open1 R edge).
+Notation lst_open := (lst_open R edge).
+Notation sc_open2 := (sc_open2 R edge).
+Notation sc_closed := (sc_closed R edge).
+Notation lst_closed := (lst_closed R edge).
+
+
+Definition update_closed_cell :=
+  update_closed_cell R 1 edge.
+
+Definition set_left_pts :=
+  set_left_pts R.
+
+Notation low := (low R edge).
+Notation high := (high R edge).
+Notation left_pts := (left_pts R edge).
+Notation right_pts := (right_pts R edge).
+Notation Bcell := (Bcell R edge).
+
+Lemma high_set_left_pts (c : cell) l : high (set_left_pts c l) = high c.
+Proof. by case: c. Qed.
+
+Definition set_pts := set_pts R edge.
+
+(* This function is to be called only when the event is in the middle
+  of the last opening cell.  The point e needs to be added to the left
+  points of one of the newly created open cells, but the one that receives
+  the first segment of the last opening cells should keep its existing
+  left points.*)
+Definition update_open_cell := 
+  update_open_cell R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1
+  edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Definition update_open_cell_top :=
+  update_open_cell_top R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1
+  edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Notation Bscan := (Bscan _ _).
+
+Definition simple_step :=
+  simple_step R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y)
+  1 edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Definition step :=
+  step R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y)
+  1 edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Definition scan events st : seq cell * seq cell :=
+  let final_state := foldl step st events in
+  (sc_open1 final_state ++ lst_open final_state :: sc_open2 final_state,
+   lst_closed final_state :: sc_closed final_state).
+
+Definition start_open_cell :=
+  start_open_cell R eq_op le +%R (fun x y => x - y)
+  *%R (fun x y => x / y) edge (@left_pt R) (@right_pt R).
+
+(*
+Definition start (events : seq event) (bottom : edge) (top : edge) :
+  seq cell * seq cell :=
+  match events with
+  | nil => ([:: start_open_cell bottom top], nil)
+  | ev0 :: events =>
+    let (newcells, lastopen) :=
+      opening_cells_aux (point ev0) (sort (@edge_below _) (outgoing ev0))
+            bottom top in
+      scan events (Bscan newcells lastopen nil nil
+         (close_cell (point ev0) (start_open_cell bottom top))
+         top (p_x (point ev0)))
+  end.
+
+*)
+
+Lemma cell_edges_sub_high bottom top (s : seq cell) :
+  cells_bottom_top bottom top s ->
+  adjacent_cells s -> cell_edges s =i bottom::[seq high c | c <- s].
+Proof.
+case: s bottom => [ | c0 s] /= bottom; first by [].
+rewrite /cells_bottom_top /cells_low_e_top=> /= /andP[] /eqP lc0 A lowhigh.
+rewrite /cell_edges=> g; rewrite mem_cat.
+have main : [seq high c | c <- c0 :: s] = 
+            rcons [seq low c | c <- s] (high (last c0 s)).
+  elim: s c0 lowhigh {lc0 A} => [ | c1 s Ih] c0 lowhigh; first by [].
+  rewrite /=.
+  move: lowhigh=> /= /andP[/eqP -> lowhigh]; congr (_ :: _).
+  by apply: Ih.
+rewrite main mem_rcons inE orbC map_cons inE -!orbA.
+rewrite !(orbCA _ (g == low _)) orbb.
+rewrite inE lc0; congr (_ || _).
+by rewrite -map_cons main mem_rcons inE.
+Qed.
+
+Lemma not_bottom_or_top bottom top (ev : event) :
+  inside_box bottom top (point ev) ->
+  out_left_event ev ->
+  {in outgoing ev, forall g, g \notin [:: bottom; top]}.
+Proof.
+move=> inbox oute g gin; apply/negP=> abs.
+have lgq : left_pt g = point ev by apply/eqP/oute.
+move: inbox=> /andP[]; rewrite -lgq; move: abs; rewrite !inE=> /orP[] /eqP ->.
+  by rewrite left_pt_below.
+by rewrite (negbTE (left_pt_above _)) !andbF.
+Qed.
+
+Section proof_environment.
+Variables bottom top : edge.
+
+Notation extra_bot := (extra_bot bottom).
+Notation close_alive_edges := (close_alive_edges bottom top).
+Notation cells_bottom_top := (cells_bottom_top bottom top).
+Notation inside_box := (inside_box bottom top).
+Notation open_cell_side_limit_ok := (@open_cell_side_limit_ok R).
+Notation seq_low_high_shift := (@seq_low_high_shift R).
+Notation cover_left_of := (@cover_left_of _ bottom top).
+
+Section open_cells_decomposition.
+
+Lemma open_cells_decomposition_contact_none open_cells p :
+  open_cells_decomposition_contact open_cells p = None ->
+  open_cells != [::] -> ~~contains_point p (head dummy_cell open_cells).
+Proof.
+rewrite /contains_point.
+case: open_cells => [// | /= c0 q].
+by case : ifP=> ? //;
+  case: (open_cells_decomposition_contact q p)=> // [] [] [].
+Qed.
+
+Lemma open_cells_decomposition_contact_main_properties open_cells p cc c' lc:
+  open_cells_decomposition_contact open_cells p = Some (cc, lc, c') ->
+  cc ++ c' :: lc = open_cells /\
+  contains_point p c' /\
+  {in cc, forall c, contains_point p c} /\
+  (lc != [::] -> ~~ contains_point p (head c' lc)).
+Proof.
+elim: open_cells cc c' lc => [ // | c q Ih] cc c' lc.
+rewrite /=; case: ifP => [ctpcc | nctpcc] //.
+case occ_eq : (open_cells_decomposition_contact _ _)
+       (@open_cells_decomposition_contact_none q p)
+    => [[[cc1 lc1] c1] | ] nonecase [] <- <- <-; last first.
+  split;[ by [] | split; [by [] | split; [by [] | ] ]].
+  by case: (q) nonecase => [// | c2 q2] ; apply.
+have [eqls [ctc1 [allct nctlc1]]] := Ih _ _  _ occ_eq.
+split; first by rewrite /=; congr (_ :: _).
+split; first by [].
+split; last by [].
+by move=> w; rewrite inE => /orP[/eqP -> // | ]; apply: allct.
+Qed.
+
+Lemma decomposition_main_properties open_cells p fc cc lcc lc le he:
+  open_cells_decomposition open_cells p = (fc, cc, lcc, lc, le, he) ->
+  (exists2 w, w \in open_cells & contains_point' p w) ->
+  open_cells = fc ++ cc ++ lcc :: lc /\
+  contains_point p lcc /\
+  {in cc, forall c, contains_point p c} /\
+  {in fc, forall c, ~~contains_point p c} /\
+  (lc != [::] -> ~~ contains_point p (head lcc lc)) /\
+  he = high lcc /\
+  le = low (head lcc cc) /\
+  le \in cell_edges open_cells /\
+  he \in cell_edges open_cells.
+Proof.
+rewrite /open_cells_decomposition/generic_trajectories.open_cells_decomposition.
+elim : open_cells fc cc lcc lc le he => [ | c q Ih] fc cc lcc lc le he.
+  by rewrite /= => _ [] w.
+rewrite /=; case: ifP=> ctc.
+  rewrite -[generic_trajectories.open_cells_decomposition_contact _ _ _ _ _
+              _ _ _ _ _ _ _]/(open_cells_decomposition_contact q p).
+  case ocdc_eq : (open_cells_decomposition_contact q p) => [[[cc0 lc0] c0]|].
+    move=> [] <- <- <- <- <- <- _.
+    have [qeq [ctc0 [allct nct]] ]:=
+     open_cells_decomposition_contact_main_properties ocdc_eq.
+    split; first by rewrite /= qeq.
+    split; first by [].
+    split; first by move=> c1 /orP[/eqP -> | ] //; apply: allct.
+    repeat (split; first by []).
+    by rewrite -qeq !mem_cat !map_f ?orbT // !(mem_cat, inE) eqxx ?orbT.
+  move=> [] <- <- <- <- <- <- _.
+  repeat (split; first by []).
+  split.
+    by move: (open_cells_decomposition_contact_none ocdc_eq); case: (q).
+  split; first by [].
+  split; first by [].
+  by rewrite !mem_cat !map_f ?orbT // inE eqxx.
+rewrite -[generic_trajectories.open_cells_decomposition_rec _ _ _ _ _
+              _ _ _ _ _ _ _ _]/(open_cells_decomposition_rec q p).
+case ocdr_eq : (open_cells_decomposition_rec q p) => [[[fc1 cc1] lcc1] lc1].
+move=> [] <- <- <- <- <- <- [] w win ctw.
+have ex2 :exists2 w, w \in q & contains_point' p w.
+  exists w; last by [].
+  move: win ctw; rewrite inE => /orP[/eqP -> | //].
+  by move=> /contains_point'W; rewrite /contains_point ctc.
+have := Ih fc1 cc1 lcc1 lc1 (low (head lcc1 cc1)) (high lcc1).
+rewrite /open_cells_decomposition_rec in ocdr_eq.
+rewrite ocdr_eq => /(_ erefl ex2).
+move=> [qeq [ctplcc1 [allct [allnct [nctlc [leeq heq]]]]]].
+split; first by rewrite /= qeq.
+split; first by [].
+split; first by [].
+split.
+  move=> c0; rewrite inE=> /orP[/eqP -> // | c0in]; last first.
+    by rewrite ?allnct.
+  by rewrite /contains_point ctc.
+repeat (split; first by []).
+by rewrite qeq !mem_cat !map_f ?orbT //; case:(cc1) => [| a b] /=; subset_tac.
+Qed.
+
+Lemma decomposition_connect_properties open_cells p 
+  first_cells contact last_contact last_cells low_f high_f:
+s_right_form open_cells ->
+seq_valid open_cells p ->
+adjacent_cells open_cells ->
+cells_bottom_top open_cells ->
+between_edges bottom top p ->
+open_cells_decomposition open_cells p  =
+  (first_cells, contact, last_contact, last_cells, low_f, high_f) ->
+[/\ p >>> low_f, p <<< high_f, valid_edge low_f p, valid_edge high_f p &
+forall c, (c \in first_cells) || (c \in last_cells) -> ~ contains_point p c].
+Proof.
+move=> rfo sval adj cbtom inbox_p oe.
+have [w win ctw'] := exists_cell cbtom adj inbox_p.
+have [ocd [ctpl [allct [allnct [nctlc [-> [-> _]]]]]]]:=
+   decomposition_main_properties oe (exists_cell cbtom adj inbox_p).
+have [A B C D E] := 
+  connect_properties cbtom adj rfo sval inbox_p ocd allnct allct ctpl nctlc.
+by split => // c cin; apply/negP/E.
+Qed.
+
+Lemma decomposition_not_end open_cells e :
+forall first_cells contact last_contact last_cells low_f high_f,
+s_right_form open_cells ->
+seq_valid open_cells (point e) ->
+adjacent_cells open_cells ->
+cells_bottom_top open_cells ->
+between_edges bottom top (point e) ->
+open_cells_decomposition open_cells (point e) =
+ (first_cells, contact, last_contact, last_cells, low_f, high_f) ->
+forall c, (c \in first_cells) || (c \in last_cells) ->
+ ( ~ event_close_edge (low c) e) /\ ( ~ event_close_edge (high c) e).
+Proof.
+move=> fc cc lcc lc low_f high_f rfo sval adj cbtom inbox_p oe c cold.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq leq]]]]]]:=
+   decomposition_main_properties oe (exists_cell cbtom adj inbox_p).
+by apply: (fclc_not_end_aux cbtom adj _ sval inbox_p ocd _ lcc_ctn flcnct).
+Qed.
+
+Lemma open_cells_decomposition_point_on open p fc cc lcc lc le he c:
+  cells_bottom_top open ->
+  adjacent_cells open ->
+  between_edges bottom top p ->
+  seq_valid open p ->
+  open_cells_decomposition open p = (fc, cc, lcc, lc, le, he) ->
+  c \in cc -> p === high c.
+Proof.
+
+move=> cbtom adj inbox_p sval oe ccc.
+have [ocd [lcc_ctn [allctn _]]]:= decomposition_main_properties oe
+           (exists_cell cbtom adj inbox_p).
+by have := in_cc_on_high adj sval ocd allctn lcc_ctn ccc.
+Qed.
+
+Lemma last_first_cells_high open p fc cc lcc lc le he :
+  cells_bottom_top open ->
+  adjacent_cells open ->
+  between_edges bottom top p ->
+  open_cells_decomposition open p = (fc, cc, lcc, lc, le, he) ->
+  last bottom [seq high i | i <- fc] = le.
+Proof.
+move=> cbtom adj inbox_p oe.
+have exi := exists_cell cbtom adj inbox_p.
+have [ocd [_ [_ [_ [_ [heq [leq _]]]]]]] :=
+   decomposition_main_properties oe exi.
+suff -> : last bottom [seq high i | i <- fc] = low (head lcc cc).
+  by rewrite leq.
+move: cbtom=> /andP[] /andP[] _ /eqP + _.
+move : adj; rewrite ocd.
+  elim/last_ind: {-1}(fc) (erefl fc) => [//= | fc' c1 _].
+    by case: (cc) => [ | c2 cc'].
+rewrite -cats1 -catA=> fceq /adjacent_catW /= [] _ + _.
+rewrite cats1 map_rcons last_rcons.
+by case: (cc) => [ | c2 cc'] /andP[] + _; rewrite /adj_rel /= => /eqP.
+Qed.
+
+Lemma head_last_cells_low open p fc cc lcc lc le he :
+  cells_bottom_top open ->
+  adjacent_cells open ->
+  between_edges bottom top p ->
+  open_cells_decomposition open p = (fc, cc, lcc, lc, le, he) ->
+  head top [seq low i | i <- lc] = he.
+Proof.
+move=> cbtom adj inbox_p oe.
+have exi := exists_cell cbtom adj inbox_p.
+have [ocd [_ [_ [_ [_ [-> _]]]]]] :=
+   decomposition_main_properties oe exi.
+move: cbtom=> /andP[] _ /eqP.
+move: adj; rewrite ocd => /adjacent_catW [] _ /adjacent_catW [] _ /=.
+  rewrite !last_cat /=.
+case : (lc) => [ | c2 lc'] //=.
+by move=> /andP[] /eqP ->.
+Qed.
+
+(* Temporary trial, but this lemma might be better placed in
+  points_and_edges. *)
+Lemma decomposition_above_high_fc p open fc cc lcc lc le he c1:
+  open_cells_decomposition open p = (fc, cc, lcc, lc, le, he) ->
+  cells_bottom_top open ->
+  adjacent_cells open ->
+  between_edges bottom top p ->
+  s_right_form open ->
+  seq_valid open p ->
+  c1 \in fc -> p >>> high c1.
+Proof.
+move=> oe cbtom adj inbox_e rfo sval c1in.
+have exi := exists_cell cbtom adj inbox_e.
+have [ocd [_ [_ [_ [_ [heq leq]]]]]] := decomposition_main_properties oe exi.
+have [pal puh vl vp _]:=
+  decomposition_connect_properties rfo sval adj cbtom inbox_e oe.
+rewrite under_pvert_y; last first.
+  apply: (seq_valid_high sval).
+  by rewrite map_f //; rewrite ocd; subset_tac.
+rewrite -ltNge.
+have : pvert_y p le < p_y p.
+  by move: pal; rewrite under_pvert_y // -ltNge.
+apply: le_lt_trans.
+move: c1in.
+have [fceq |[fc' [lfc fceq]]]: fc = nil \/ exists fc' lfc, fc = rcons fc' lfc.
+    by elim/last_ind : (fc) => [ | fc' lfc _];[left | right; exists fc', lfc].
+  by rewrite fceq.
+have := last_first_cells_high cbtom adj inbox_e oe.
+rewrite fceq map_rcons last_rcons => <-.
+rewrite mem_rcons inE => /orP[/eqP c1lfc | c1o]; first  by rewrite c1lfc.
+have [a [b pab]] := mem_seq_split c1o.
+move: fceq; rewrite pab -cats1 -catA /= => fceq.
+(* requirement for path_edge_below_pvert_y *)
+have req1 : all (valid_edge (R := _) ^~ p)
+    [seq high i | i <- c1 :: b ++ [:: lfc]].
+  apply/allP; apply: (sub_in1 _ (seq_valid_high sval)); apply: sub_map.
+  by rewrite ocd fceq; subset_tac.
+have req2 : path (@edge_below R) (high c1) [seq high i | i <- b ++ [:: lfc]].
+  have := seq_edge_below' adj rfo.
+  rewrite ocd (_ : fc = rcons a c1 ++ rcons b lfc); last first.
+     by move: fceq; rewrite -!cats1 !catA /= -!catA /=.
+  rewrite -!catA [X in path _ _ X]map_cat cat_path=> /andP[] _.
+  rewrite !map_rcons last_rcons map_cat cat_path => /andP[] + _.
+  by rewrite -cats1.
+have : path (<=%R) (pvert_y p (high c1))
+  [seq pvert_y p (high i) | i <- b ++ [:: lfc]].
+  by have := path_edge_below_pvert_y req1 req2; rewrite -map_comp.
+rewrite le_path_sortedE => /andP[] /allP + _.
+move=> /(_ (pvert_y p (high lfc))); apply.
+by rewrite (map_f (fun c => pvert_y p (high c))) //; subset_tac.
+Qed.
+
+Lemma decomposition_under_low_lc p open fc cc lcc lc le he c1:
+  open_cells_decomposition open p = (fc, cc, lcc, lc, le, he) ->
+  cells_bottom_top open ->
+  adjacent_cells open ->
+  between_edges bottom top p ->
+  s_right_form open ->
+  seq_valid open p ->
+  c1 \in lc -> p <<< low c1.
+Proof.
+move=> oe cbtom adj inbox_e rfo sval c1in.
+have exi := exists_cell cbtom adj inbox_e.
+have [ocd _] := decomposition_main_properties oe exi.
+rewrite strict_under_pvert_y; last first.
+  by apply/(seq_valid_low sval)/map_f; rewrite ocd; subset_tac.
+have [pal puh vl vp _]:=
+  decomposition_connect_properties rfo sval adj cbtom inbox_e oe.
+have puhe : p_y p < pvert_y p he.
+  by move: puh; rewrite strict_under_pvert_y.
+apply: (lt_le_trans puhe).
+move: c1in; case lceq : lc => [ // | flc lc'] c1in.
+have := head_last_cells_low cbtom adj inbox_e oe.
+rewrite lceq /= => <-.
+move: c1in; rewrite inE => /orP[/eqP c1flc | c1o]; first by rewrite c1flc.
+have [a [b Pab]] := mem_seq_split c1o.
+(* requirement for path_edge_below_pvert_y *)
+have req1 : all (@valid_edge R ^~ p)
+  [seq low i | i <- flc :: a ++ c1 :: b].
+  apply/allP; apply: (sub_in1 _ (seq_valid_low sval)); apply: sub_map.
+  by rewrite ocd lceq Pab; subset_tac.
+have req2 : path (@edge_below R) (low flc) [seq low i | i <- a ++ c1 :: b].
+  have := seq_edge_below' adj rfo.
+  have [on0 headq] : open != [::] /\ low (head dummy_cell open) = bottom.
+    by move: cbtom=> /andP[] /andP[] + /eqP + _.
+  have headq' : head dummy_edge [seq low i | i <- open] = bottom.
+      by move: on0 headq; case: (open)=> [ // | ? ?] /=.
+  rewrite headq' => pathoh.
+  have : path (@edge_below R) bottom (bottom :: [seq high i | i <- open]).
+      by rewrite /= edge_below_refl.
+  have  := seq_low_high_shift on0 adj; rewrite headq => <-.
+  rewrite -cats1 cat_path => /andP[] + _.
+  rewrite ocd lceq Pab.
+  by rewrite 2!map_cat 2!cat_path /= => /andP[] _ /andP[] _ /andP[] _ /andP[].
+have : path (<=%R) (pvert_y p (low flc))
+  [seq pvert_y p (low i) | i <- a ++ c1 :: b].
+  by have := path_edge_below_pvert_y req1 req2; rewrite -map_comp.
+rewrite le_path_sortedE => /andP[] /allP + _.
+move=> /(_ (pvert_y p (low c1))); apply.
+by rewrite (map_f (fun c => pvert_y p (low c))); subset_tac.
+Qed.
+
+End open_cells_decomposition.
+
+Lemma open_cells_decomposition_cat f l p :
+   adjacent_cells (f ++ l) ->
+   s_right_form (f ++ l) ->
+   seq_valid (f ++ l) p ->
+   (exists2 c, c \in l & contains_point' p c) ->
+   p >>> low (head dummy_cell l) ->
+   let '(fc', cc, lcc, lc, le, he) :=
+     open_cells_decomposition l p in
+   open_cells_decomposition (f ++ l) p =
+     (f ++ fc', cc, lcc, lc, le, he).
+Proof.
+move=> + + + exi pal.
+elim: f => [ | c0 f Ih].
+  move=> adj rfo sval.
+ by case: (open_cells_decomposition l p) => [[[[[fc cc] lcc] lc] le] he].
+rewrite /= => adj /andP[] lbh0 rfo /andP[] /andP[] vlc0 vhc0 sval.
+case ocal_eq : (open_cells_decomposition l p) =>
+  [[[[[fc' cc'] lcc'] lc'] le'] he'].
+case oca_eq : (open_cells_decomposition _ _) =>
+  [[[[[fc1 cc1] lcc1] lc1] le1] he1].
+have exi0 : exists2 c, c \in c0 :: f ++ l & contains_point' p c.
+  by case: exi => c cin A; exists c=> //; subset_tac.
+have := decomposition_main_properties oca_eq exi0 =>
+  -[ocd [lcc_ctn [allct [allnct [flnct [heq [leq [lein hein]]]]]]]].
+have := decomposition_main_properties ocal_eq exi =>
+  -[ocd' [lcc_ctn' [allct' [allnct' [flnct' [heq' [leq' [lein' hein']]]]]]]].
+have svalf : seq_valid f p.
+  by apply/allP=> x xin; apply: (allP sval); subset_tac.
+have rfof : s_right_form f.
+  by apply/allP=> x xin; apply: (allP rfo); subset_tac.
+have adjf : adjacent_cells f.
+  by move: adj; rewrite cat_path=> /andP[] /path_sorted.
+have hfq : high (last c0 f) = low (head dummy_cell l).
+  case: (l) adj exi => [ | c1 l']; first by move => _ [].
+  by rewrite cat_path /==> /andP[] _ /andP[] /eqP.
+move: oca_eq; rewrite /open_cells_decomposition/generic_trajectories.open_cells_decomposition /=.
+case: ifP=> [c0ctn | c0nctn].
+  move: c0ctn; rewrite /generic_trajectories.contains_point -[X in _ && X]negbK.
+  have [/eqP f0 | fn0] := boolP (f == nil).
+    by move: hfq; rewrite f0 /= => ->; rewrite pal andbF.
+  have := above_all_cells svalf adjf rfof.
+  have -> : high (last dummy_cell f) = high (last c0 f).
+    by case: (f) fn0.
+  rewrite hfq pal=> /(_ isT) [] palf _.
+  have -> : high c0 = low (head dummy_cell f).
+    by move: adj fn0; case: (f) => [// | ? ?] /= /andP[] /eqP.
+  by rewrite palf andbF.
+move: ocal_eq; rewrite /open_cells_decomposition/generic_trajectories.open_cells_decomposition.
+rewrite -/(open_cells_decomposition_rec _ _).
+case ocal_eq: (open_cells_decomposition_rec _ _) =>
+  [[[fc2 cc2] lcc2] lc2] [] <- <- <- <- <- <-.
+have adj' : adjacent_cells (f ++ l).
+  by move: adj=> /path_sorted.
+have := Ih adj' rfo sval; rewrite /open_cells_decomposition.
+rewrite /generic_trajectories.open_cells_decomposition.
+rewrite /open_cells_decomposition_rec in ocal_eq. rewrite ocal_eq.
+rewrite -/(open_cells_decomposition_rec _ _).
+case: (open_cells_decomposition_rec (f ++ l) p) => [[[fc4 cc4] lcc4] lc4].
+by move=> -[] -> -> -> -> _ _ [] <- <- <- <- <- <-.
+Qed.
+
+Lemma open_cells_decomposition_cat' f l p :
+  adjacent_cells (f ++ l) ->
+  s_right_form (f ++ l) ->
+  seq_valid (f ++ l) p ->
+  (exists2 c, c \in (f ++ l) & contains_point' p c) ->
+  f != nil ->
+  p >>> high (last dummy_cell f) ->
+   let '(fc', cc, lcc, lc, le, he) :=
+     open_cells_decomposition l p in
+   open_cells_decomposition (f ++ l) p =
+     (f ++ fc', cc, lcc, lc, le, he).
+Proof.
+move=> adj rfo sval [w win wctn] fnnil paf.
+have adjf : adjacent_cells f by move: adj=> /adjacent_catW[].
+have rfof : s_right_form f.
+  by apply/allP=> x xin; apply: (allP rfo); subset_tac.
+have svalf : seq_valid f p.
+  by apply/allP=> x xin; apply: (allP sval); subset_tac.
+have winl : w \in l.
+  have [_ abaf] := above_all_cells svalf adjf rfof paf.
+  have wnf : w \notin f.
+    apply/negP=> abs.
+    by move: wctn; rewrite /contains_point' -[X in _ && X]negbK abaf ?andbF //.
+  by move: win; rewrite mem_cat (negbTE wnf).
+have exi' : exists2 c, c \in l & contains_point' p c by exists w.
+have hfq : high (last dummy_cell f) = low (head dummy_cell l).
+  move: adj fnnil.
+  case:(f) => [ // | c0 f']; rewrite /= cat_path=> /andP[] _ + _.
+  by move: winl; case: (l) => [ // | c1 l'] _ /= /andP[] /eqP.
+by apply: open_cells_decomposition_cat; rewrite // -hfq.
+Qed.
+
+Lemma open_cells_decomposition_single f l c p :
+  adjacent_cells (f ++ c :: l) ->
+  s_right_form (f ++ c :: l) ->
+  seq_valid (f ++ c :: l) p ->
+  p >>> low c ->
+  p <<< high c ->
+  open_cells_decomposition (f ++ c :: l) p =
+    (f, nil, c, l, low c, high c).
+Proof.
+move=> adj srf sv pal puh.
+have exi : exists2 c', c' \in (c :: l) & contains_point' p c'.
+  by exists c;[ rewrite inE eqxx // | rewrite /contains_point' pal underW].
+have := open_cells_decomposition_cat adj srf sv exi pal.
+case ocl : (open_cells_decomposition (c :: l) p) =>
+        [[[[[fc cc] lcc] lc] le] he].
+move: ocl; rewrite /open_cells_decomposition /=.
+rewrite /generic_trajectories.open_cells_decomposition /=.
+rewrite -/(contains_point _ _).
+have -> : contains_point p c.
+  by rewrite contains_pointE underWC // underW.
+case lq : l => [ | c1 l'] /=.
+  by move=> [] <- <- <- <- <- <-; rewrite cats0.
+rewrite -/(contains_point _ _).
+suff -> : contains_point p c1 = false.
+  by move=> [] <- <- <- <- <- <-; rewrite cats0.
+move: adj=> /adjacent_catW[] _; rewrite lq /= => /andP[] /eqP lc1q  _.
+by rewrite contains_pointE -lc1q puh.
+Qed.
+
+Section step.
+
+
+Variable e : event.
+Variable fop : seq cell.
+Variable lsto : cell.
+Variable lop : seq cell.
+Variable cls : seq cell.
+Variable lstc :  cell.
+Variable lsthe : edge.
+Variable lstx : R.
+Variable future_events : seq event.
+Variable p : pt.
+
+Let open := (fop ++ lsto :: lop).
+
+(* lsto is only guaranteed to be the highest of the last created cells. *)
+(* It might be the case that the next event is in the left side of this *)
+(* cell *)
+#[clearbody]
+Let lstoin : lsto \in open.
+Proof.  by rewrite /open; subset_tac. Defined.
+
+
+Hypothesis inbox_all_edges :
+  all (fun g => (g \in [:: bottom; top]) ||
+        (inside_box (left_pt g) && inside_box (right_pt g)))
+      (cell_edges open).
+Hypothesis inbox_all_events :
+  all inside_box [seq point x | x <- (e :: future_events)].
+
+#[clearbody]
+Let inbox_e : inside_box (point e).
+Proof. by have /andP[] := inbox_all_events. Defined.
+
+#[clearbody]
+Let inbox_es : all inside_box [seq point x | x <- future_events].
+Proof. by have /andP[] := inbox_all_events. Defined.
+
+Hypothesis oute : out_left_event e.
+Hypothesis rfo : s_right_form open.
+Hypothesis cbtom : cells_bottom_top open.
+Hypothesis adj : adjacent_cells open.
+Hypothesis sval : seq_valid open (point e).
+Hypothesis cle : close_edges_from_events (e :: future_events).
+Hypothesis clae : close_alive_edges open (e :: future_events).
+Hypothesis lstheq : lsthe = high lsto.
+Hypothesis lstheqc : lsthe = high lstc.
+Hypothesis lstxq : lstx = left_limit lsto.
+Hypothesis abovelstle :
+  p_x (point e) = lstx -> (point e) >>> low lsto.
+Hypothesis elexp : lexePt (point e) p.
+Hypothesis plexfut : {in future_events, forall e', lexePt p (point e')}.
+Hypothesis inbox_p : inside_box p.
+Hypothesis noc : {in all_edges open (e :: future_events) &, no_crossing R}.
+Hypothesis sort_evs : path (@lexPtEv _) e future_events.
+Hypothesis pwo : pairwise (@edge_below _) (bottom :: [seq high c | c <- open]).
+Hypothesis btom_left_corners :
+  {in open, forall c, lexPt (bottom_left_corner c) (point e)}.
+Hypothesis open_side_limit : all open_cell_side_limit_ok open.
+Hypothesis close_side_limit : all (@closed_cell_side_limit_ok _)
+   (rcons cls lstc).
+Hypothesis lex_left_limit :
+  all (fun x => lexPt x (point e)) (behead (left_pts lsto)).
+Hypothesis disjoint_open_closed :
+  {in open & rcons cls lstc, disjoint_open_closed_cells R}.
+Hypothesis disjoint_closed : {in rcons cls lstc &, disjoint_closed_cells R}.
+Hypothesis closed_right_limit :
+ {in rcons cls lstc, forall c, right_limit c <= p_x (point e)}.
+Hypothesis uniq_closed : uniq (rcons cls lstc).
+Hypothesis non_empty_closed :
+  {in rcons cls lstc, forall c, exists p, inside_closed' p c}.
+Hypothesis non_empty_right : right_pts lstc != [::] :> seq pt.
+Hypothesis uniq_out : uniq (outgoing e).
+Hypothesis high_inj : {in open &, injective high}.
+Hypothesis btm_left : bottom_left_cells_lex open (point e).
+Hypothesis uniq_open : uniq open.
+Hypothesis open_non_inner :
+    {in open, forall c, non_inner (high c) (point e)}.
+Hypothesis lex_open_edges :
+   {in [seq high c | c <- open], forall g, lexPt (left_pt g) (point e) &&
+          lexePt (point e) (right_pt g)}.
+Hypothesis left_limit_has_right_limit :
+  {in open, forall c p, inside_box p -> left_limit c = p_x p ->
+    contains_point' p c -> has (inside_closed' p) (rcons cls lstc)}.
+Hypothesis cover_left_of_e : cover_left_of (point e) open (rcons cls lstc).
+
+(* Thanks to the disoc lemma, we only need to prove that the high edges
+  of all open cells satisfy the pairwise property for edge_below to
+  obtain disjointness of cells. *)
+
+Lemma disoc_i i j s : (i < j < size s)%N ->
+  adjacent_cells s ->
+  pairwise (@edge_below _) [seq high c | c <- s] ->
+  all open_cell_side_limit_ok s ->
+  o_disjoint_e (nth dummy_cell s i) (nth dummy_cell s j).
+Proof.
+move=> + adjs pws open_side_limit_s.
+move=> /andP[] iltj jlts.
+have ilts : (i < size s)%N by apply: ltn_trans jlts.
+set x := nth dummy_cell s i.
+set y := nth dummy_cell s j.
+have iin : x \in s by apply: mem_nth.
+have jin : y \in s by apply: mem_nth.
+have xok : open_cell_side_limit_ok x by apply: (allP open_side_limit_s).
+have yok : open_cell_side_limit_ok y by apply: (allP open_side_limit_s).
+right=> q; apply/negP=> /andP[].
+move=> /andP[] /[dup] inx /(inside_open_cell_valid xok) /andP[] _ vhx _.
+move=> /andP[] /[dup] iny /(inside_open_cell_valid yok) /andP[] vly _.
+move=> /andP[] qay _.
+move: inx=> /andP[] /andP[] _ quhx _.
+case/negP:qay.
+move: iltj; rewrite leq_eqVlt=> /orP[/eqP/esym jq | ].
+  move: adjs.
+  rewrite -(cat_take_drop j.+1 s)=> /adjacent_catW[] + _.
+  rewrite (take_nth dummy_cell jlts) -/y jq (take_nth dummy_cell ilts) -/x.
+  rewrite -2!cats1 -catA /= =>/adjacent_catW[] _ /=.
+  by rewrite andbT=> /eqP <-.
+move=> i1ltj.
+set j' := j.-1.
+have jj : j = j'.+1 by rewrite (ltn_predK i1ltj).
+have j'lts : (j' < size s)%N.
+  by apply: ltn_trans jlts; rewrite jj.
+have iltj' : (i < j')%N by rewrite -ltnS -jj.
+move: adjs.
+rewrite -(cat_take_drop j.+1 s)=> /adjacent_catW[] + _.
+rewrite (take_nth dummy_cell jlts) -/y jj (take_nth dummy_cell j'lts).
+rewrite -2!cats1 -catA /= =>/adjacent_catW[] _ /= /andP[] /eqP lyq _.
+apply: (order_edges_viz_point' vhx) => //.
+rewrite -lyq.
+move: pws => /(pairwiseP dummy_edge) /(_ i j') /=; rewrite size_map 2!inE.
+move=> /(_ ilts j'lts iltj').
+by rewrite -[dummy_edge]/(high dummy_cell) !(nth_map dummy_cell).
+Qed.
+
+Lemma disoc s:
+  adjacent_cells s ->
+  pairwise (@edge_below _) [seq high c | c <- s] ->
+  all open_cell_side_limit_ok s ->
+ {in s &, disjoint_open_cells R}.
+Proof.
+move=> adjs pws sok.
+move=> x y xin yin.
+set i := find (pred1 x) s.
+set j := find (pred1 y) s.
+case : (leqP i j) => [ | jlti]; last first.
+  have ilts : (i < size s)%N by rewrite -has_find has_pred1.
+  have jint : (j < i < size s)%N by rewrite jlti ilts.
+  move: xin; rewrite -has_pred1=> /(nth_find dummy_cell) => /eqP <-.
+  move: yin; rewrite -has_pred1=> /(nth_find dummy_cell) => /eqP <-.
+  by apply/o_disjoint_eC/disoc_i.
+rewrite leq_eqVlt=> /orP[/eqP ij | iltj].
+  move: xin; rewrite -has_pred1=> /(nth_find dummy_cell) /= /eqP.
+  rewrite -/i ij /j.
+  move: yin; rewrite -has_pred1=> /(nth_find dummy_cell) /= /eqP -> ->.
+  by left.
+have jlto : (j < size s)%N by rewrite -has_find has_pred1.
+have jint : (i < j < size s)%N by rewrite iltj jlto.
+move: xin; rewrite -has_pred1=> /(nth_find dummy_cell) => /eqP <-.
+move: yin; rewrite -has_pred1=> /(nth_find dummy_cell) => /eqP <-.
+by apply/disoc_i.
+Qed.
+
+#[clearbody]
+Let bet_e : between_edges bottom top (point e).
+Proof. by apply inside_box_between. Defined.
+
+#[clearbody]
+Let exi : exists2 c, c \in open & contains_point' (point e) c.
+Proof. by apply: (exists_cell cbtom adj bet_e). Defined.
+
+Lemma close_cell_ok c :
+  contains_point (point e) c ->
+  valid_edge (low c) (point e) -> valid_edge (high c) (point e) ->
+  open_cell_side_limit_ok c ->
+  closed_cell_side_limit_ok (close_cell (point e) c).
+Proof.
+move=> ctp vl vh.
+rewrite /open_cell_side_limit_ok/closed_cell_side_limit_ok.
+rewrite /close_cell /=; have /exists_point_valid [p1 /[dup] vip1 ->] := vl.
+have /exists_point_valid [p2 /[dup] vip2 -> /=] := vh.
+move=> /andP[] -> /andP[]-> /andP[]-> /andP[] -> -> /=.
+have [o1 /esym/eqP x1]:=intersection_on_edge vip1.
+have [o2 /eqP x2]:=intersection_on_edge vip2.
+rewrite -?(eq_sym (point e)).
+(* TODO : this line performs a lot of complicated things, but they mostly
+   failed at porting time. *)
+case:ifP (o1) (o2) =>[/eqP q1 |enp1];case:ifP=>[/eqP q2 |enp2];
+  rewrite ?q1 ?q2;
+  rewrite -?q1 -?q2 /= ?eqxx ?x2 ?x1 /= => -> -> //; rewrite /= ?andbT.
+- move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] _ eh.
+  have := (under_edge_strict_lower_y x2 (negbT enp2) eh o2).
+  rewrite q1=> ->; rewrite andbT.
+  by rewrite /right_limit /= x2 eqxx.
+- move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el _.
+  have := (above_edge_strict_higher_y x1 _ el).
+  by rewrite eq_sym (negbT enp1)=> /(_ isT); apply.
+move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el eh.
+rewrite (above_edge_strict_higher_y x1 _ el) //; last first.
+  by rewrite eq_sym enp1.
+rewrite  (under_edge_strict_lower_y x2 (negbT enp2) eh) //.
+by rewrite -x1 x2 eqxx.
+Qed.
+
+Lemma closing_cells_side_limit' cc :
+  s_right_form cc ->
+  seq_valid cc (point e) ->
+  adjacent_cells cc ->
+  all open_cell_side_limit_ok cc ->
+  all (contains_point (point e)) cc ->
+  point e >>> low (head dummy_cell cc) ->
+  point e <<< high (last dummy_cell cc) ->
+  all (@closed_cell_side_limit_ok _) (closing_cells (point e) cc).
+Proof.
+move=> rfc valc adjc oks ctps abovelow belowhigh.
+rewrite /closing_cells.
+rewrite all_map.
+apply/allP=> //= c cin.
+have vlc: valid_edge (low c) (point e) by have:= (allP valc c cin) => /andP[].
+have vhc : valid_edge (high c) (point e)
+   by have := (allP valc c cin) => /andP[].
+apply: close_cell_ok=> //.
+  by apply: (allP ctps).
+by apply: (allP oks).
+Qed.
+
+Lemma close'_subset_contact q c :
+  valid_cell c (point e) ->
+  closed_cell_side_limit_ok (close_cell (point e) c) ->
+  inside_closed' q (close_cell (point e) c) -> inside_open' q c.
+Proof.
+move=>[] vl vh.
+move=>/closed_right_imp_open.
+rewrite inside_open'E // inside_closed'E /close_cell.
+have [p1 vip1] := exists_point_valid vl.
+have [p2 vip2] := exists_point_valid vh.
+rewrite vip1 vip2 /= => cok /andP[] -> /andP[] -> /andP[] -> rlim /=.
+by apply: (le_trans rlim cok).
+Qed.
+
+Lemma close_cell_right_limit c :
+  valid_cell c (point e) ->
+  right_limit (close_cell (point e) c) = p_x (point e).
+Proof.
+move=> [vl vh].
+rewrite /close_cell; rewrite !pvertE // /right_limit /=.
+by case: ifP=> cnd1 //; case: ifP=> cnd2.
+Qed.
+
+Definition state_open_seq (s : scan_state) :=
+  sc_open1 s ++ lst_open s :: sc_open2 s.
+
+Definition inv1_seq (s : seq cell) :=
+  close_alive_edges s future_events /\
+  (future_events = [::] \/
+    seq_valid s (point (head dummy_event future_events))) /\
+  adjacent_cells s /\ cells_bottom_top s /\ s_right_form s.
+
+Definition invariant1 (s : scan_state) :=
+  inv1_seq (state_open_seq s).
+
+Let val_between g (h : valid_edge g (point e)) := 
+  valid_between_events elexp plexfut h inbox_p.
+
+#[clearbody]
+Let subo : {subset outgoing e <= all_edges open (e :: future_events)}.
+Proof. by rewrite /all_edges; subset_tac. Defined.
+
+#[clearbody]
+Let subo' : {subset sort (@edge_below _) (outgoing e)
+                 <= all_edges open (e :: future_events)}.
+Proof.
+by move=> x; rewrite mem_sort=> xo; apply: subo.
+Defined.
+
+#[clearbody]
+Let oute' : {in sort (@edge_below _) (outgoing e),
+    forall g, left_pt g == (point e)}.
+Proof. by move=> x; rewrite mem_sort; apply: oute. Defined.
+
+(* This was a temporary movement section for objects
+  transferred to the opening_cells section, but now it seems
+  opening_cells_pairwise has to stay in this part of the world. *)
+
+Lemma opening_cells_pairwise le he :
+   point e >>> le ->
+   point e <<< he ->
+   le \in all_edges open (e :: future_events) ->
+   he \in all_edges open (e :: future_events) ->
+   valid_edge le (point e) ->
+   valid_edge he (point e) ->
+   pairwise (@edge_below _)
+         [seq high x | x <- (opening_cells (point e) (outgoing e) le he)].
+Proof.
+move=> pal puh lein hein vle vhe.
+apply: opening_cells_pairwise'=> //.
+have sub : {subset [:: le, he & outgoing e] <=
+               all_edges open (e :: future_events)}.
+  move=> g1; rewrite !inE=> /orP[/eqP -> | /orP[/eqP -> | gin]] //.
+  by rewrite mem_cat events_to_edges_cons !mem_cat gin !orbT.
+by move=> g1 g2 /sub g1in /sub g2in; apply: noc.
+Qed.
+
+(* end of temporary moving area. *)
+Lemma invariant1_default_case :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) :=
+      opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  inv1_seq ((fc ++ nos) ++ lno :: lc).
+Proof.
+case oe : (open_cells_decomposition open (point e)) =>
+ [[[[[fc cc] lcc] lc] le] he].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe ncont] :=
+    decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos nlsto].
+rewrite /invariant1 /state_open_seq /=.
+have dec_not_end :=
+    decomposition_not_end rfo sval adj cbtom bet_e oe.
+have close_fc : close_alive_edges fc future_events.
+  suff/head_not_end : close_alive_edges fc (e :: future_events).
+    by apply=> c0 cin; apply: dec_not_end; rewrite cin.
+  by apply/allP=> c0 cin; apply: (allP clae); rewrite ocd; subset_tac.
+have close_lc : close_alive_edges lc future_events.
+  suff/head_not_end : close_alive_edges lc (e :: future_events).
+    by apply=> c0 cin; apply: dec_not_end; rewrite cin orbT.
+  by apply/allP=> c0 cin; apply: (allP clae); rewrite ocd; subset_tac.
+have endle : end_edge_ext bottom top le future_events.
+  suff  : end_edge_ext bottom top le (e :: future_events).
+    rewrite /end_edge_ext; move=> /orP[-> // | ] /= /orP[ | ->]; last first.
+      by rewrite orbT.
+    by move: pal=> /[swap] /eqP <-; rewrite right_pt_below.
+  have := (proj1 (andP (allP clae (head lcc cc) _))); rewrite leq; apply.
+  by rewrite ocd; subset_tac.
+have endhe : end_edge_ext bottom top he future_events.
+  suff  : end_edge_ext bottom top he (e :: future_events).
+    rewrite /end_edge_ext; move=> /orP[-> // | ] /= /orP[ | ->]; last first.
+      by rewrite orbT.
+    move: puh=> /[swap] /eqP <-; rewrite strict_nonAunder; last first.
+      by apply: valid_edge_right.
+    by rewrite right_on_edge.
+  have := (proj2 (andP (allP clae lcc _))); rewrite ?heq; apply.
+  by rewrite ocd; subset_tac.
+move: cle => /= /andP[] cloe _.
+have clan := opening_cells_close vle vhe oute endle endhe cloe.
+have main := (insert_opening_closeness close_fc clan close_lc).
+split.
+  by move: main; rewrite /opening_cells oca_eq -cats1 -!catA.
+have subfc : {subset fc <= open} by rewrite ocd; subset_tac.
+have sublc : {subset lc <= open} by rewrite ocd; subset_tac.
+(* TODO : redo this as it is overkill for what follows. *)
+have svaln :
+  forall q, inside_box q -> lexePt (point e) q ->
+   {in future_events, forall e', lexePt q (point e')} ->
+   seq_valid ((fc ++ nos) ++ nlsto :: lc) q.
+  move=> q inbox_q elexq qlexfut.
+  apply/allP=> x; rewrite !(mem_cat, inE) -orbA => /orP[xf | ].
+    have /andP [vlx vhx] := allP sval x (subfc _ xf).
+    have := (allP main x); rewrite mem_cat xf => /(_ isT) /andP claex.
+    by rewrite (valid_between_events elexq qlexfut vlx inbox_q)
+     ?(valid_between_events elexq qlexfut vhx inbox_q); case: claex.
+  rewrite orbA=> /orP[ | xl]; last first.
+    have /andP [vlx vhx] := allP sval x (sublc _ xl).
+    move: (elexq);rewrite lexePt_eqVlt => /orP[/eqP <- | elexp'].
+      by rewrite vlx vhx.
+    have := (allP main x).
+    rewrite 2!mem_cat xl !orbT => /(_ isT) /andP claex.
+    by rewrite (valid_between_events elexq qlexfut vlx inbox_q)
+    ?(valid_between_events elexq qlexfut vhx inbox_q); case: claex.
+  move=> xin; have xin' : x \in opening_cells (point e) (outgoing e) le he.
+    by rewrite /opening_cells oca_eq mem_rcons inE orbC.
+  have [vlx vhx] := andP (allP (opening_valid oute vle vhe) _ xin').
+  have [eelx eehx] := andP (allP clan _ xin').
+  by rewrite (valid_between_events elexq qlexfut vlx inbox_q)
+    ?(valid_between_events elexq qlexfut vhx inbox_q).
+split.
+  case futq : future_events => [ | ev2 fut']; first by left.
+  right; rewrite /=.
+  apply: svaln.
+      by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite map_f // futq inE eqxx.
+    apply: lexPtW.
+    by move: sort_evs; rewrite futq /= => /andP[].
+  move=> e'; rewrite futq inE => /orP[/eqP -> | ].
+    by apply: lexePt_refl.
+  move=> e'in; apply/lexPtW.
+  move: sort_evs; rewrite futq /= => /andP[] _.
+  rewrite path_sortedE; last by move=> x y z; apply: lexPt_trans.
+  by move=> /andP[] /allP /(_ e' e'in).
+have [adjnew lownew] := adjacent_opening_aux vle vhe oute' oca_eq.
+have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq heq /=.
+move=> hnlsto.
+split.
+  suff : adjacent_cells ((fc ++ nos) ++ nlsto :: lc) by [].
+  rewrite -catA.
+  have oldnnil : rcons cc lcc != nil.
+    by apply/eqP/rcons_neq0.
+  rewrite -cat_rcons; apply: (replacing_seq_adjacent oldnnil).
+  - by apply/eqP/rcons_neq0.
+  - by rewrite lownew; move: leq; case: (cc) => [ | ? ?].
+  - by rewrite !last_rcons.
+  - by move: adj; rewrite ocd cat_rcons.
+  by apply: adjnew.
+have nn0 : rcons nos nlsto != nil by apply/eqP/rcons_neq0.
+have on0 : rcons cc lcc != nil by apply/eqP/rcons_neq0.
+move: cbtom; rewrite ocd -cat_rcons => cbtom'.
+have hds: low (head dummy_cell (rcons cc lcc)) =
+  low (head dummy_cell (rcons nos nlsto)).
+  by rewrite head_rcons -leq -lownew head_rcons.
+have tls : high (last dummy_cell (rcons cc lcc)) =
+          high (last dummy_cell (rcons nos nlsto)).
+  by rewrite !last_rcons.
+split.
+  move: cbtom'; 
+  rewrite (replacing_seq_cells_bottom_top _ _ _ _ on0 nn0) //.
+  by rewrite -catA cat_rcons.
+rewrite -catA -cat_rcons.
+have lein' : le \in all_edges open (e :: future_events).
+  by rewrite /all_edges; subset_tac.
+have hein' : he \in all_edges open (e :: future_events).
+  by rewrite /all_edges; subset_tac.
+have lebhe : le <| he.
+  by apply: (edge_below_from_point_above (noc _ _) vle vhe (underWC _)).
+have noc2 : {in [:: le, he & outgoing e] &, no_crossing R}.
+  by apply: (sub_in2 _ noc); rewrite /all_edges; subset_tac.
+have subso : {subset sort (@edge_below _) (outgoing e)
+                <= all_edges open (e :: future_events)}.
+  by move=> x; rewrite mem_sort; apply: subo.
+apply/allP=> x; rewrite 2!mem_cat orbCA => /orP[xin | xold]; last first.
+  by apply: (allP rfo); rewrite ocd; move: xold => /orP[] ?; subset_tac.
+have srt : path (@edge_below _) le (sort (@edge_below _) (outgoing e)).
+  by have := sorted_outgoing vle vhe pal puh oute noc2.
+have := (opening_cells_aux_right_form (underWC pal) puh vle vhe
+               lein' hein' lebhe oute' noc subso srt oca_eq).
+by move=> /allP /(_ x xin).
+Qed.
+
+#[clearbody]
+Let exi' : point e >>> lsthe ->
+  exists2 c, c \in lop & contains_point' (point e) c.
+Proof.
+rewrite lstheq; move=> pa.
+suff abf : {in fop, forall c, point e >>> high c}.
+have [wc wcin wcct] := exi; exists wc => //.
+  move: wcin; rewrite /open !(mem_cat, inE) => /orP[wf | /orP[/eqP wl | //]].
+    by move: wcct; rewrite /contains_point' (negbTE (abf _ wf)) andbF.
+  by move: wcct; rewrite /contains_point' wl (negbTE pa) andbF.
+have vfop1 : seq_valid (rcons fop lsto) (point e).
+  apply/allP=> x; rewrite mem_rcons=> xin; apply: (allP sval).
+  by move: x xin; rewrite /open; change {subset lsto::fop <= open}; subset_tac.
+have vfop : {in rcons fop lsto, forall c, valid_edge (high c) (point e)}.
+  move=> c cin.
+  have cin' : high c \in [seq high i | i <- open].
+    by apply: map_f; rewrite /open -cat_rcons; subset_tac.
+  by apply: (seq_valid_high sval cin').
+have rfop : s_right_form (rcons fop lsto).
+  by apply: all_sub rfo; rewrite /open -cat_rcons; subset_tac.
+have afop : adjacent_cells (rcons fop lsto).
+  by move: adj; rewrite /open -cat_rcons => /adjacent_catW [].
+have vh : valid_edge (low (head lsto fop)) (point e).
+  by move: sval; rewrite /open; case: (fop) => [ | ? ?] /= /andP[] /andP[].
+suff [] : point e >>> low (head lsto fop) /\
+       {in fop, forall c, point e >>> high c} by [].
+have := above_all_cells vfop1 afop rfop; rewrite last_rcons=> /(_ pa).
+have hq : head dummy_cell (rcons fop lsto) = head lsto fop.
+  by case: (fop) => [ | ? ?].
+rewrite hq => -[-> others]; split=> // x xin.
+by apply: others; rewrite mem_rcons inE xin orbT.
+Defined.
+
+Lemma inv1_seq_set_pts s1 s2 c1 lpts1 lpts2 :
+  inv1_seq (s1 ++ set_pts c1 lpts1 lpts2 :: s2) <->
+  inv1_seq (s1 ++ c1 :: s2).
+Proof.
+rewrite /inv1_seq.
+have -> : close_alive_edges (s1 ++ set_pts c1 lpts1 lpts2 :: s2)
+ future_events =
+  close_alive_edges (s1 ++ c1 :: s2) future_events.
+  by rewrite /close_alive_edges !all_cat /=.
+have -> : adjacent_cells (s1 ++ set_pts c1 lpts1 lpts2 :: s2) =
+  adjacent_cells (s1 ++ c1 :: s2).
+  elim/last_ind : s1 => [ | [ | c0 s1] c0' _]; case: s2 => [ | c2 s2] //=;
+  by rewrite /adjacent_cells ?cat_rcons ?cat_path //.
+have -> : cells_bottom_top (s1 ++ set_pts c1 lpts1 lpts2 :: s2) =
+  cells_bottom_top (s1 ++ c1 :: s2).
+  rewrite /cells_bottom_top /cells_low_e_top.
+  by case: s1 => [ | c0 s1]; elim/last_ind: s2 => [ | s2 c2 _];
+   rewrite /= -?cat_rcons ?(last_rcons, cats0, last_cat).
+have -> : s_right_form (s1 ++ set_pts c1 lpts1 lpts2 :: s2) =
+  s_right_form (s1 ++ c1 :: s2).
+  by rewrite /s_right_form !all_cat /=.
+split; move=> [-> [B [-> [-> -> ]]]]; split=> //; split=> //.
+  case: B; first by left.
+  by rewrite /seq_valid !all_cat /=; right.
+case: B; first by left.
+by rewrite /seq_valid !all_cat /=; right.
+Qed.
+
+Lemma inv1_seq_set_left_pts s1 s2 c1 lpts :
+  inv1_seq (s1 ++ set_left_pts c1 lpts :: s2) <->
+  inv1_seq (s1 ++ c1 :: s2).
+Proof. exact (inv1_seq_set_pts s1 s2 c1 lpts (right_pts c1)). Qed.
+
+#[clearbody]
+Let vlo : valid_edge (low lsto) (point e).
+Proof. by apply: (proj1 (andP (allP sval lsto lstoin))). Defined.
+
+#[clearbody]
+Let vho : valid_edge (high lsto) (point e).
+Proof. by apply: (proj2 (andP (allP sval lsto lstoin))). Defined.
+
+Lemma last_step_situation fc' cc lcc lc le he:
+  open_cells_decomposition (lsto :: lop) (point e) =
+    (fc', cc, lcc, lc, le, he) ->
+  p_x (point e) = lstx ->
+  ~~ (point e <<< lsthe) ->
+  point e <<= lsthe ->
+  fc' = [::] /\ le = low lsto /\ exists cc', cc = lsto :: cc'.
+Proof.
+move=> oe pxhere eabove ebelow.
+have lsto_ctn : contains_point' (point e) lsto.
+  by rewrite /contains_point' -lstheq ebelow abovelstle.
+have exi2 : exists2 c, c \in (lsto :: lop) & contains_point' (point e) c.
+  by exists lsto; rewrite // inE eqxx.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]]
+  := decomposition_main_properties oe exi2.
+have fc'0 : fc' = [::].
+  case fc'q : fc' => [// | fc'i fc2].
+  move: ocd; rewrite fc'q /= => - [] lstoisfc'i _.
+  move: (all_nct lsto).
+  by rewrite (contains_point'W lsto_ctn) fc'q lstoisfc'i inE eqxx =>/(_ isT).
+split; first by [].
+case ccq: cc => [ | cc0 cc'].
+  move: ocd; rewrite fc'0 ccq /= => -[] lstoq.
+  move: heq; rewrite -lstoq.
+  have := open_cells_decomposition_cat adj rfo sval exi2 (abovelstle pxhere).
+  rewrite oe => oe'.
+  have [ocd' [lcc_ctn' [all_ct' [all_nct' [flcnct' [heq' [leq' [_ _]]]]]]]]
+    := decomposition_main_properties oe exi2.
+  have [pal puh vle vhe]:=
+    decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+  by move: puh; rewrite heq' -lstoq -lstheq (negbTE eabove).
+have [ fopq | [fop' [lfop fopq]]] :
+  fop = nil \/ exists fop' lfop, fop = rcons fop' lfop.
+    elim/last_ind: (fop) => [| fop' lfop]; first by left.
+    by right; exists fop', lfop.
+  move: ocd; rewrite -cat_rcons fc'0 /= => lstohead.
+  split.
+    suff : lsto = head lcc cc by move=> ->.
+    by rewrite -[LHS]/(head lsto (lsto :: lop)) lstohead; case: (cc).
+  by exists cc'; move: lstohead; rewrite ccq /= => -[] ->.
+move: adj; rewrite /open ocd fopq fc'0 cat_rcons /=.
+move=> /adjacent_catW[] _ it.
+move: (ocd); rewrite fc'0 /=; move: it=> /[swap] <- /andP[] /eqP <- _.
+split.
+  apply/esym; rewrite leq.
+  move: adj; rewrite /open ocd fc'0 /= fopq cat_rcons=>/adjacent_catW[] _.
+  by rewrite ccq /= => /andP[] /eqP ->.
+by exists cc'; move: ocd; rewrite fc'0 ccq /= => -[] ->.
+Qed.
+
+#[clearbody]
+Let loin : low lsto \in all_edges open (e :: future_events).
+Proof. by rewrite 2!mem_cat map_f. Defined.
+
+#[clearbody]
+Let hoin : high lsto \in all_edges open (e :: future_events).
+Proof. by rewrite 2!mem_cat map_f // orbT. Defined.
+
+Arguments pt_eqb : simpl never.
+
+Lemma step_keeps_invariant1 :
+  invariant1 (step (Bscan fop lsto lop cls lstc lsthe lstx) e).
+Proof.
+case step_eq : (step _ _) => [fop' lsto' lop' cls' lstc' lsthe' lstx']. 
+rewrite /state_open_seq /=; move: step_eq.
+rewrite /step/generic_trajectories.step -/open.
+have val_bet := valid_between_events elexp plexfut _ inbox_p.
+case: ifP=> [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
+  move: invariant1_default_case.
+  rewrite -/(open_cells_decomposition _ _).
+  case oe: (open_cells_decomposition _ _) => [[[[[fc cc ] lcc] lc] le] he].
+  rewrite /generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno] def_case.
+  rewrite /inv1_seq /= in def_case.
+  move=> [] <- <- <- _ _ _ _.
+  by apply: def_case.
+have infop : {subset fop <= open} by rewrite /open; subset_tac.
+have sval1 : seq_valid fop (point e).
+  by apply/allP=> x xin; apply: (allP sval); apply: infop.
+have rfo1 : s_right_form fop.
+  by apply/allP=> x xin; apply: (allP rfo); apply: infop.
+have adj1 : adjacent_cells fop.
+  by move: adj; rewrite /open => /adjacent_catW[].
+have allnct1 : {in fop, forall c, ~contains_point (point e) c}.
+  case fop_eq : fop => [// | c1 fop1].
+  have := above_all_cells sval1 adj1 rfo1.
+  have hfopq : high (last dummy_cell fop) = low lsto.
+    move: adj.
+    by rewrite /open fop_eq /= cat_path => /andP[] _ /= /andP[] /eqP.
+  move: palstol; rewrite hfopq=> -> /(_ isT) [] _ M.
+  by rewrite -fop_eq=> x xin; rewrite contains_pointE (negbTE (M x xin)) andbF.
+have inlop : {subset lop <= open} by rewrite /open; subset_tac.
+have lopclae : close_alive_edges lop (e :: future_events).
+  by apply/allP=> x xin; apply: (allP clae x); apply inlop.
+have fop_note x : x \in fop ->
+  ~ event_close_edge (low x) e /\ ~ event_close_edge (high x) e.
+  move=> xin; apply: contrapositive_close_imp_cont.
+  - by apply: (allP rfo); rewrite /open; subset_tac.
+  - by apply/andP; apply: (allP sval); rewrite /open; subset_tac.
+  by apply: allnct1.
+have fopclae : close_alive_edges fop (e :: future_events).
+  by apply/allP=> x xin; apply: (allP clae); rewrite /open; subset_tac.
+move: (cle) => /= /andP[] cloe _.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe: (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite /generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  have oe' :
+    open_cells_decomposition open (point e) =
+     (rcons fop lsto ++ fc', cc, lcc, lc, le, he).
+    move: adj rfo sval; rewrite /open -cat_rcons=> adj' rfo' sval'.
+    move: (open_cells_decomposition_cat adj' rfo' sval' (exi' eabove)).
+    by rewrite oe; apply.
+  move=> [] <- <- <- _ _ _ _.
+  have := invariant1_default_case.
+  by rewrite oe' oca_eq  /= cat_rcons.
+have /andP [vllsto vhlsto] : valid_edge (low lsto) (point e) &&
+                       valid_edge (high lsto) (point e).
+  by move: sval=> /allP/(_ lsto); rewrite /open; apply; subset_tac.
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite -/(update_open_cell lsto e).
+  case uoceq : (update_open_cell lsto e) => [ nos lno] <-.
+  rewrite /invariant1 /= /state_open_seq /= -catA -cat_rcons.
+  move: uoceq; rewrite /update_open_cell/generic_trajectories.update_open_cell.
+  case ogq : (outgoing e) => [ | fog ogs] /=.
+    move=> -[] <- <- /=; rewrite inv1_seq_set_left_pts.
+    have := invariant1_default_case.
+    rewrite open_cells_decomposition_single=> //; last by rewrite -lstheq.
+    rewrite ogq /=.
+    do 2 rewrite -/(vertical_intersection_point _ _).
+    rewrite pvertE // pvertE //=; rewrite cats0.
+    rewrite -[pt_eqb _ _ (point e) _]/((point e) == _:> pt).
+    rewrite -[pt_eqb _ _ _ (point e)]/(_ == (point e):> pt).
+    have /negbTE -> :
+         (Bpt (p_x (point e)) (pvert_y (point e) (high lsto)))
+           != point e :> pt.
+      rewrite pt_eqE /= eqxx /=.
+      move: ebelow_st; rewrite -/(_ <<< _).
+      rewrite strict_under_pvert_y lstheq // lt_neqAle eq_sym.
+      by move=> /andP[].
+    have /negbTE -> :
+     point e != Bpt (p_x (point e)) (pvert_y (point e) (low lsto)) :> pt.
+      rewrite pt_eqE /= eqxx /=.
+      by move: palstol; rewrite under_pvert_y // le_eqVlt negb_or=> /andP[].
+    set w := [:: _ ; _; _].
+    by rewrite (inv1_seq_set_pts fop lop lsto w nil).
+  have := invariant1_default_case.
+  rewrite open_cells_decomposition_single=> //; last by rewrite -lstheq.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  rewrite ogq; case oca_eq: opening_cells_aux => [[| no0 nos'] lno'].
+    have ognn : (outgoing e) != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vho ognn oute.
+    by rewrite ogq oca_eq.
+  by move => + [] <- <- /=; rewrite inv1_seq_set_left_pts cat_rcons -!catA /=.
+have lsto_ctn : contains_point'(point e) lsto.
+  rewrite /contains_point'.
+  by rewrite -lstheq /point_under_edge (negbFE ebelow) abovelstle.
+have exi2 : exists2 c, c \in (lsto :: lop) & contains_point' (point e) c.
+  by exists lsto; rewrite // inE eqxx.
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite oe => oe'.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+  decomposition_main_properties oe' exi.
+have [ocd' _] := decomposition_main_properties oe exi2.
+have [fc'0 [lelsto [cc' ccq]]] : fc' = [::] /\ le = low lsto /\
+          exists cc', cc = lsto :: cc'.
+  by have := last_step_situation oe pxhere (negbT eonlsthe) (negbFE ebelow).
+rewrite /generic_trajectories.update_open_cell_top.
+rewrite -/(open_cells_decomposition _ _).
+rewrite oe.
+case o_eq : (outgoing e) => [ | g l]; rewrite -?o_eq; last first.
+  rewrite -!/(open_cells_decomposition _ _).
+  have := invariant1_default_case; rewrite oe'.
+  rewrite -lelsto.
+  rewrite -!/(opening_cells_aux _ _ _ _).
+  case: (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+    move=> + <-; rewrite /invariant1 /state_open_seq /=.
+    by rewrite !cats0 -!catA.
+  move=> + <-; rewrite /invariant1 /state_open_seq /=.
+  rewrite -!catA /= => it.
+  by rewrite (catA fop) inv1_seq_set_left_pts -catA.
+move=> [] <- <- <- _ _ _ _ /=.
+have subf : {subset (fop ++ fc') <= open} by rewrite /open ocd; subset_tac.
+have adjf : adjacent_cells (fop ++ fc').
+  by move: adj; rewrite /open ocd=> /adjacent_catW[].
+have claef : close_alive_edges (fop ++ fc') (e :: future_events).
+  by apply/allP=> x xin; apply: (allP clae); apply: subf.
+have rfof : s_right_form (fop ++ fc').
+  by apply/allP=> x xin; apply: (allP rfo); apply: subf.
+have svalf : seq_valid (fop ++ fc') (point e).
+  by apply/allP=> x xin; apply: (allP sval); apply: subf.
+have subl : {subset (lsto :: lop) <= open}.
+  by rewrite /open; subset_tac.
+have adjl : adjacent_cells (lsto :: lop).
+  by move: adj=> /adjacent_catW[].
+have rfol : s_right_form (lsto :: lop).
+  by apply/allP=> x xin; apply: (allP rfo); apply: subl.
+have svall : seq_valid (lsto :: lop) (point e).
+  by apply/allP=> x xin; apply: (allP sval); apply: subl.
+have cbtom' : cells.cells_bottom_top (low lsto) top (lsto :: lop).
+  move: cbtom; rewrite /open /cells.cells_bottom_top /cells_low_e_top eqxx //=.
+  by move=> /andP[] _; rewrite last_cat /=.
+have [pal puh vl vh not_ct] :=
+  decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+have claef' : close_alive_edges (fop ++ fc') future_events.
+  elim/last_ind: {-1}(fop ++ fc') (erefl (fop ++ fc')) => [// | fc2 c2 _] f_eq.
+  have hc2q : high c2 = low (head lcc cc).
+    move: adj; rewrite /open ocd catA f_eq -cats1 -!catA=> /adjacent_catW[] _.
+    by rewrite ccq /= => /andP[] /eqP.
+  have palst : point e >>> high (last dummy_cell (fop ++ fc')).
+    by rewrite f_eq last_rcons hc2q -leq.
+  have [above_l above_h] := above_all_cells svalf adjf rfof palst.
+  have {}allabove_l : {in fop ++ fc', forall c, point e >>> low c}.
+    move=> c /mem_seq_split [s1 [s2 s_q]].
+      elim/last_ind: {-1} (s1) (erefl s1) => [ | s1' c1 _] s1q.
+        by move: above_l; rewrite s_q s1q /=.
+      have : point e >>> high c1.
+        by rewrite above_h // s_q s1q cat_rcons; subset_tac.
+      have /eqP -> // : high c1 == low c.
+      move: adjf; rewrite s_q s1q -cats1 -catA /= => /adjacent_catW[] _.
+      by rewrite /= => /andP[].
+  have f_not_end : forall c, c \in fop ++ fc' ->
+  ~ event_close_edge (low c) e /\ ~ event_close_edge (high c) e.
+    move=> c cin; apply: contrapositive_close_imp_cont.
+    - by apply: (allP rfof).
+    - by apply/andP; apply: (allP svalf).
+    by apply/negP; rewrite contains_pointE (negbTE (above_h _ cin)) andbF.
+  apply/allP=> x; rewrite -f_eq => xin.
+  by apply: (allP (head_not_end claef f_not_end)).  
+have clael : close_alive_edges lc (e :: future_events).
+  by apply/allP=> x xin; apply: (allP clae); rewrite /open ocd; subset_tac.
+have clael' : close_alive_edges lc future_events.
+  case lc_eq : (lc) => [ // | c2 lc2]; rewrite -lc_eq.
+  have [puhlcc adj2] : point e <<< low (head dummy_cell lc) /\
+                        adjacent_cells lc.
+    move: adj; rewrite /open ocd lc_eq.
+    move=> /adjacent_catW[] _ /adjacent_catW[] _ /=.
+    by move=> /andP[] /eqP <- ->; rewrite -heq.
+  have sub2 : {subset lc <= open} by rewrite /open ocd; subset_tac.
+  have sval2 : seq_valid lc (point e).
+    by apply/allP=> x xin; apply: (allP sval); apply: sub2.
+  have rfo2 : s_right_form lc.
+    by apply/allP=> x xin; apply: (allP rfo); apply: sub2.
+  have below_h : {in lc, forall c, point e <<< high c}.
+    exact: (below_all_cells sval2 adj2 rfo2 puhlcc).
+  have below_l : {in lc, forall c, point e <<< low c}.
+    move=> c /mem_seq_split [s1 [s2 s_q]].
+    elim/last_ind: {2}(s1) (erefl s1) => [ | s1' c1 _] s1_q.
+      by move: puhlcc; rewrite s_q s1_q /=.
+    move: adj2; rewrite s_q s1_q -cats1 -catA=> /adjacent_catW [] _ /=.
+    move=> /andP[]/eqP <- _; apply: below_h.
+    rewrite s_q s1_q cat_rcons; subset_tac.
+  have l_not_end : forall c, c \in lc ->
+  ~ event_close_edge (low c) e /\ ~ event_close_edge (high c) e.
+    move=> c cin; apply: contrapositive_close_imp_cont.
+    - by apply: (allP rfo2).
+    - by apply/andP; apply: (allP sval2).
+    by apply/negP; rewrite contains_pointE negb_and negbK (below_l _ cin).
+  apply/allP=> x xin.
+  by apply: (allP (head_not_end clael l_not_end)).
+rewrite cats0 /invariant1 /state_open_seq /=; set open' := (X in inv1_seq X).
+have clae_part : close_alive_edges open' future_events.
+  rewrite /close_alive_edges all_cat [all _ (fop ++ fc')]claef' /=.
+  rewrite [all _ lc]clael' andbT.
+  have le_end : end_edge_ext bottom top le future_events.
+    elim/last_ind: {-1} (fop ++ fc') (erefl (fop ++ fc')) => [ | fs c1 _] f_eq.
+      move: f_eq; case fop_eq: (fop) => [ | //].
+      move: cbtom; rewrite /open fop_eq /= => /andP[] /andP[] _ /= /eqP + _.
+      by rewrite /end_edge_ext lelsto !inE => -> _; rewrite eqxx.
+    have <- : high c1 = le.
+      rewrite fc'0 cats0 in f_eq.
+      move: adj; rewrite /open f_eq -cats1 -catA=>/adjacent_catW[] _ /=.
+      by rewrite lelsto; move=> /andP[] /eqP.
+    apply: (proj2 (andP (allP claef' c1 _))).
+    by rewrite f_eq mem_rcons inE eqxx.
+  have he_end : end_edge_ext bottom top he future_events.
+    case lc_eq : lc => [ | c1 lc'].
+      have hetop : he = top.
+        move: cbtom=> /andP[] /andP[] _ _.
+        by rewrite /open ocd lc_eq !last_cat -heq /= => /eqP.
+      by rewrite /end_edge_ext hetop !inE eqxx ?orbT.
+    have hlccq : high lcc = low c1.
+      move: adj; rewrite /open ocd lc_eq.
+      by move=> /adjacent_catW[] _ /adjacent_catW[] _ /andP[] /eqP.
+    have c1in : c1 \in lc by rewrite lc_eq inE eqxx.
+    by have := (allP clael' _ c1in) => /andP[] + _; rewrite -hlccq -heq.
+  by rewrite -lelsto le_end he_end.
+split=> //.
+have vhe : valid_edge he (point e).
+ by have []:= decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+split.
+  case futq : future_events => [ | e2 fut]; first by left.
+  have elexe2 : lexePt (point e) (point e2).
+    by apply/lexPtW; move: sort_evs; rewrite futq /= => /andP[].
+  rewrite /seq_valid all_cat /= all_cat andbCA.
+  have e2lexfut : {in future_events, forall e, lexePtEv e2 e}.
+    move=> e'; rewrite futq inE=> /orP[/eqP ->|]; first by apply: lexePt_refl.
+    move=> e'in; apply/lexPtW; move: sort_evs; rewrite futq=> /= /andP[] _.
+    rewrite path_sortedE; last by move=> x y z; apply: lexPt_trans.
+    by move=> /andP[] /allP /(_ e') + _; apply.
+  have inbox_e2 : inside_box (point e2).
+    by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite futq /= inE eqxx.
+  right.
+  apply/andP; split; last first.
+    rewrite -!all_cat fc'0 cats0; apply/allP=> x xin.
+    have /andP[vlx vhx] :
+    valid_edge (low x) (point e) && valid_edge (high x) (point e).
+      apply: (allP sval); rewrite /open ocd.
+      by move: xin; rewrite mem_cat=> /orP[] ?; subset_tac.
+    have /andP[eelx eehx] :
+     end_edge_ext bottom top (low x) future_events &&
+     end_edge_ext bottom top (high x) future_events.
+      apply: (allP clae_part). 
+      by rewrite /open'; move: xin; rewrite mem_cat=>/orP[] ?; subset_tac.
+    by rewrite !(valid_between_events elexe2 e2lexfut _ inbox_e2).
+  have eelo : end_edge_ext bottom top (low lsto) future_events.
+    have : end_edge_ext bottom top (low lsto) (e :: future_events).
+      by apply: (proj1 (andP (allP clae lsto _))).
+    rewrite /end_edge_ext /= => /orP[-> // | /orP[abs | ->]]; last first.
+      by rewrite !orbT.
+    by move: palstol; rewrite -(eqP abs) right_pt_below.
+  have eehe : end_edge_ext bottom top he future_events.
+    have : end_edge_ext bottom top (high lcc) (e :: future_events).
+      apply: (proj2 (andP (allP clae lcc _))).
+      by rewrite /open ocd; subset_tac.
+    rewrite /end_edge_ext heq /= => /orP[-> // | /orP[abs | ->]]; last first.
+      by rewrite orbT.
+    by move: puh; rewrite heq -(eqP abs) -[_ <<< _]negbK right_pt_above.
+  by rewrite !(valid_between_events elexe2 e2lexfut _ inbox_e2).
+split.
+  case feq : fop => [ | c0 f].
+    rewrite /open' feq fc'0 /=.
+    move: adj; rewrite /open ocd => /adjacent_catW[] _ /adjacent_catW[] _ /=.
+    by case: (lc)=> [ // | c2 lc'] /=; rewrite heq.
+  rewrite /open' -adjacent_cut /=; last by rewrite feq.
+  apply/andP; split.
+    apply/andP; split; last by move: adj; rewrite /open ocd=> /adjacent_catW.
+    rewrite fc'0 cats0; move: adj; rewrite /open feq /= cat_path /=.
+    by move=> /andP[] _ /andP[].
+  move: adj; rewrite /open ocd=> /adjacent_catW[] _ /adjacent_catW[] _ /=.
+  by case: (lc) => [// | c2 l'] /=; rewrite heq.
+have on0 : rcons cc lcc != nil by apply/eqP/rcons_neq0.
+rewrite /open'.
+set nc := Bcell _ _ _ _.
+have nn0 : [:: nc] != nil by [].
+split.
+  rewrite -(replacing_seq_cells_bottom_top _ _ _ _ on0 nn0).
+  - by rewrite cat_rcons -ocd.
+  - rewrite /nc /= head_rcons.
+    by rewrite -leq.
+  by rewrite /nc/= last_rcons.
+rewrite /s_right_form all_cat /=; apply/andP; split.
+  by apply/allP=> x xin; apply: (allP rfo); rewrite /open ocd; subset_tac.
+apply/andP; split; last first.
+  by apply/allP=> x xin; apply: (allP rfo); rewrite /open ocd; subset_tac.
+have noclstohe : below_alt he (low lsto).
+  by apply: noc; rewrite /all_edges; subset_tac.
+have := edge_below_from_point_under noclstohe vhe vlo (underW puh) palstol.
+by [].
+Qed.
+
+Lemma pairwise_subst {T : Type} [leT : rel T] (os ns s1 s2 : seq T) :
+  pairwise leT (s1 ++ os ++ s2) ->
+  pairwise leT ns ->
+  allrel leT s1 ns ->
+  allrel leT ns s2 ->
+  pairwise leT (s1 ++ ns ++ s2).
+Proof.
+rewrite !pairwise_cat !allrel_catr => /andP[] /andP[] _ -> /andP[] ->.
+by move=>/andP[] _ /andP[] _ -> -> -> ->.
+Qed.
+
+Lemma pairwise_subst1 {T : eqType} [leT : rel T] (oc nc : T)(s1 s2 : seq T) :
+  leT nc =1 leT oc -> leT^~ nc =1 leT^~ oc ->
+  pairwise leT (s1 ++ oc :: s2) = pairwise leT (s1 ++ nc :: s2).
+Proof.
+move=> l r.
+by rewrite !(pairwise_cat, pairwise_cons, allrel_consr) (eq_all l) (eq_all r).
+Qed.
+
+Lemma new_edges_above_first_old fc cc lcc lc le:
+  open = fc ++ cc ++ lcc :: lc ->
+  all (fun x => valid_edge x(point e))
+        [seq high x | x <- fc ++ cc ++ lcc :: lc] ->
+  pairwise (@edge_below _) [seq high x | x <- fc ++ cc ++ lcc :: lc] ->
+  all ((@edge_below _)^~ le) [seq high x | x <- fc] ->
+  point e >>> le ->
+  point e <<< high lcc ->
+  valid_edge le (point e) ->
+  allrel (@edge_below _) 
+    [seq high c | c <- fc]
+    [seq high c | c <- 
+      opening_cells (point e) (outgoing e) le (high lcc)].
+Proof.
+move=> ocd.
+rewrite !map_cat !all_cat => /andP[] vfc /andP[] _ /= /andP[] vhe _.
+move=> + fcbl pal puh vle.
+rewrite !pairwise_cat=> /andP[] fcbcc /andP[] _ /andP[] /=.
+rewrite allrel_consr=> /andP[] pw' _ /andP[] pw _.
+rewrite /opening_cells.
+case oca_eq : opening_cells_aux => [s c].
+have := opening_cells_aux_high vle vhe oute'; rewrite oca_eq /= => highsq.
+have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq /= => highcq.
+rewrite -cats1 map_cat allrel_catr allrel_consr /=.
+have -> : all ((@edge_below _)^~ (high c)) [seq high x | x <- fc].
+  rewrite highcq; move: fcbcc; rewrite allrel_catr allrel_consr.
+  by move=> /andP[] _ /andP[].
+rewrite allrel0r.
+have -> //: allrel (@edge_below _) [seq high x | x <- fc][seq high y | y <- s].
+rewrite highsq.
+apply/allrelP=> x y xin yin.
+have vx : valid_edge x (point e) by apply: (allP vfc).
+have vy : valid_edge y (point e).
+  by apply: valid_edge_extremities; rewrite oute'.
+have puy : point e <<= y.
+  by rewrite -(eqP (oute' yin)); apply: left_pt_below.
+have xble : x <| le by apply: (allP fcbl).
+have pax : point e >>> x.
+  apply/negP=> pux; case/negP: pal.
+  by apply: (order_edges_viz_point' vx vle xble pux).
+have nocyx : below_alt y x.
+  apply: noc; rewrite ocd /all_edges/events_to_edges; last first.
+    by rewrite !(cell_edges_cat, mem_cat) ?xin ?orbT //.
+  rewrite /= mem_cat [X in (_ || X)]mem_cat.
+  by rewrite mem_sort in yin; rewrite yin !orbT.
+by have := edge_below_from_point_under nocyx vy vx puy pax.
+Qed.
+
+Lemma new_edges_below_last_old fc cc lcc lc le:
+  open = fc ++ cc ++ lcc :: lc ->
+  all (fun x => valid_edge x(point e))
+        [seq high x | x <- fc ++ cc ++ lcc :: lc] ->
+  pairwise (@edge_below _) [seq high x | x <- fc ++ cc ++ lcc :: lc] ->
+  point e >>= le ->
+  point e <<< high lcc ->
+  valid_edge le (point e) ->
+  allrel (@edge_below _) 
+    [seq high c | c <- 
+      opening_cells (point e) (outgoing e) le (high lcc)]
+        [seq high c | c <- lc].
+Proof.
+move=> ocd.
+rewrite !map_cat !all_cat => /andP[] _ /andP[] _ /= /andP[] vhe vlc.
+move=> + pal puh vle.
+rewrite !pairwise_cat=> /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+rewrite /= => /andP[] heblc _.
+rewrite /opening_cells.
+case oca_eq : opening_cells_aux => [s c].
+have := opening_cells_aux_high vle vhe oute'; rewrite oca_eq /= => highsq.
+have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq /= => highcq.
+rewrite -cats1 allrel_mapl allrel_catl /= allrel_consl allrel0l ?andbT.
+rewrite highcq heblc andbT.
+rewrite -allrel_mapl highsq; apply/allrelP=> x y /[dup] xin xin' yin.
+rewrite mem_sort in xin'.
+have vx: valid_edge x (point e) by apply valid_edge_extremities; rewrite oute'.
+have vy: valid_edge y (point e) by apply: (allP vlc).
+have highlccley : high lcc <| y by apply: (allP heblc).
+have puy : point e <<< y.
+  by have := order_edges_strict_viz_point' vhe vy highlccley puh.
+have pax : point e >>= x.
+  rewrite -(eqP (oute' xin)); apply left_pt_above.
+have nocxy : below_alt x y.
+  apply: noc; rewrite /all_edges/events_to_edges/= ocd !mem_cat ?xin' ?orbT //.
+  by rewrite !map_cat /= !mem_cat !inE yin !orbT.
+by have := edge_below_from_point_above nocxy vx vy pax puy.
+Qed.
+
+Lemma step_keeps_pw_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+  open_cells_decomposition open (point e) in
+  let '(nos, lno) := 
+    opening_cells_aux (point e)
+        (sort (@edge_below _) (outgoing e)) le he in
+    pairwise (@edge_below _) 
+       (bottom :: [seq high x | x <- fc ++ nos ++ lno :: lc]).
+Proof.
+case oe: (open_cells_decomposition open (point e)) =>
+  [[[[[fc cc] lcc] lc] le] he].
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]]
+  := decomposition_main_properties oe exi.
+have [pal puh vle vhe allnct] :=
+  decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have oc_eq : opening_cells (point e) (outgoing e) le he = rcons nos lno.
+  by rewrite /opening_cells oca_eq.
+rewrite /=; apply/andP; split.
+  rewrite map_cat all_cat; apply/andP; split.
+    by move: pwo; rewrite ocd /= map_cat all_cat=> /andP[] /andP[] ->.
+  rewrite -cat_rcons map_cat all_cat; apply/andP; split; last first.
+    move: pwo; rewrite ocd /= !map_cat !all_cat /=.
+    by move=> /andP[] + _; do 3 move=> /andP[] _.
+  rewrite map_rcons all_rcons.
+  have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq /= => ->.
+  have -> /= : bottom <| he.
+    have lcco : lcc \in open by rewrite ocd !mem_cat inE eqxx !orbT. 
+    rewrite heq.
+    move: pwo=> /= /andP[] /allP /(_ (high lcc)) + _; rewrite map_f //.
+    by apply.
+  have := opening_cells_aux_high vle vhe oute'; rewrite oca_eq /= => ->.
+  apply/allP=> g; rewrite mem_sort=> gin.
+  have lgq : left_pt g = point e by apply/eqP/oute.
+  have vlg : valid_edge bottom (left_pt g).
+    by rewrite lgq; apply: (inside_box_valid_bottom inbox_e).
+(* TODO : this should be made a top level lemma *)
+  have /no_crossingE : below_alt g bottom.
+    apply: noc.
+      by rewrite mem_cat /events_to_edges /= !mem_cat gin !orbT.
+    rewrite 2!mem_cat -orbA; apply/orP; left.
+    move: cbtom=> /andP[]; case: (open) => [ // | o1 op'] /= /eqP -> _.
+    by rewrite inE eqxx.
+  move=> /(_ vlg) [] _; apply.
+  by move: inbox_e=> /andP[] /andP[] + _ _; rewrite lgq.
+rewrite -cat_rcons.
+rewrite pairwise_map.
+move: pwo; rewrite pairwise_cons ocd -cat_rcons pairwise_map=> /andP[] _ pwo'.
+have vhocd : all ((@valid_edge _)^~ (point e))
+     [seq high x | x <- fc ++ cc ++ lcc :: lc].
+  by rewrite -ocd; apply/allP; apply: seq_valid_high.
+move: (pwo'); rewrite cat_rcons -pairwise_map=> pwo2.
+have puh' : point e <<< high lcc by rewrite -heq.
+apply: (pairwise_subst pwo'); rewrite -?pairwise_map.
+- rewrite -oc_eq.
+  have lein' : le \in all_edges open (e :: future_events).
+    by rewrite mem_cat lein.
+  have hein' : he \in all_edges open (e :: future_events).
+    by rewrite mem_cat hein.
+  by apply: opening_cells_pairwise.
+- have : allrel (@edge_below _) [seq high x | x <- fc]
+          [seq high x | x <- rcons nos lno].
+    have fcle : all ((@edge_below _)^~ le) [seq high x | x <- fc].
+      apply/allP=> x /mapP[xc xcin xq].
+      elim/last_ind : {-1} (fc) (erefl fc) => [ | fc' lfc _] fcq.
+        by move: xcin; rewrite fcq.
+      have := last_first_cells_high cbtom adj bet_e oe => <-.
+      rewrite fcq map_rcons last_rcons xq.
+      move: xcin; rewrite fcq mem_rcons inE=> /orP[/eqP -> | xcin ].
+        by apply: edge_below_refl.
+      move: pwo'; rewrite pairwise_cat fcq pairwise_rcons=> /andP[] _ /andP[].
+      by move=> /andP[] + _ _ => /allP /(_ xc xcin) /=.
+    have := new_edges_above_first_old ocd vhocd pwo2 fcle pal puh' vle.
+    by rewrite -oc_eq heq.
+  by rewrite allrel_mapr allrel_mapl.
+have : allrel (@edge_below _) [seq high x | x <- rcons nos lno]
+            [seq high x | x <- lc].
+   have := new_edges_below_last_old ocd vhocd pwo2 (underWC pal) puh' vle.
+   by rewrite -heq oc_eq.
+by rewrite allrel_mapl allrel_mapr.
+Qed.
+
+#[clearbody]
+Let open_edge_valid x :
+   x \in cell_edges open -> valid_edge x (point e).
+Proof.
+by rewrite /cell_edges mem_cat => /orP[] /mapP [c /(allP sval) /andP[]+ + ->].
+Defined.
+
+Lemma step_keeps_pw :
+  pairwise (@edge_below _)
+     (bottom ::
+       [seq high x | x <- state_open_seq (step (Bscan fop lsto lop cls lstc
+           lsthe lstx) e)]).
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP=> [pxaway | /negbFE/eqP/[dup] pxhere/abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition (fop ++ lsto :: lop) (point e))=>
+    [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  move: step_keeps_pw_default; rewrite /open.
+  by rewrite oe oca_eq /state_open_seq /= catA.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe: (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  have oe' :
+    open_cells_decomposition open (point e) =
+     (rcons fop lsto ++ fc', cc, lcc, lc, le, he).
+    move: adj rfo sval; rewrite /open -cat_rcons=> adj' rfo' sval'.
+    move: (open_cells_decomposition_cat adj' rfo' sval' (exi' eabove)).
+    by rewrite oe; apply.
+  have := step_keeps_pw_default; rewrite oe' oca_eq.
+  rewrite [state_open_seq _]
+           (_ : _ = (rcons fop lsto ++ fc') ++ nos ++ lno :: lc); last first.
+    by rewrite /state_open_seq /= cat_rcons !catA.
+  by apply.
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite /state_open_seq /=.
+  rewrite /generic_trajectories.update_open_cell.
+  case oq : (outgoing e) => [ | fog ogs] /=.
+    rewrite cats0 map_cat /=; apply/andP; split.
+      move: pwo; rewrite pairwise_cons /open => /andP[] + _.
+      by rewrite map_cat.
+    move: pwo; rewrite pairwise_cons /open=> /andP[] _.
+    by rewrite map_cat /=.
+  have ocd : open_cells_decomposition open (point e) =
+          (fop, [::], lsto, lop, low lsto, high lsto).
+    by rewrite open_cells_decomposition_single; rewrite // -lstheq.
+  have same_left cg lpts : (fun c' => (edge_below (high cg) (high c'))) =1
+      (fun c' => (edge_below (high (set_left_pts cg lpts))(high c'))).
+    by move=> c'; rewrite /set_left_pts /=.
+  have same_right cg lpts : (fun c' => edge_below (high c') (high cg)) =1
+      (fun c' => edge_below (high c') (high (set_left_pts cg lpts))).
+    by move=> c'; rewrite /set_left_pts /=.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | f s] c] /=.
+    rewrite cats0 -cat_rcons.
+    have:= step_keeps_pw_default.
+    rewrite ocd oq oca_eq /= cat_rcons !pairwise_map => pw.
+    have onn : outgoing e != [::] by rewrite oq.
+    have := opening_cells_aux_absurd_case vlo vho onn oute.
+    by rewrite oq oca_eq.
+  have := step_keeps_pw_default.
+  rewrite ocd oq oca_eq /= !pairwise_map => pw.
+  rewrite -catA /=.
+  apply/andP; split.
+    by move: pw=> /andP[] + _; rewrite !map_cat !all_cat /=.
+  have := @pairwise_subst1 _
+                 (fun c1 c2 => edge_below (high c1) (high c2)) f
+      (set_left_pts f [:: point e & behead (left_pts lsto)]
+) fop (s ++ c :: lop)
+      (same_left f (point e :: behead (left_pts lsto)))
+      (same_right f (point e :: behead (left_pts lsto))) => <-.
+  by move: pw=> /andP[] _.
+(* Now the point is on lsthe *)
+(* Next12 lines duplicated from the end of step_keeps_invariant1 *)
+have lsto_ctn : contains_point'(point e) lsto.
+  rewrite /contains_point'.
+  by rewrite -lstheq /point_under_edge (negbFE ebelow) abovelstle.
+have exi2 : exists2 c, c \in (lsto :: lop) & contains_point' (point e) c.
+  by exists lsto; rewrite // inE eqxx.
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+  rewrite oe => oe'.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+  decomposition_main_properties oe' exi.
+have [ocd' _] := decomposition_main_properties oe exi2.
+have [fc'0  [lelsto [cc' ccq]]] : fc' = [::] /\ le = low lsto /\
+  exists cc', cc = lsto :: cc'.
+  by have := last_step_situation oe pxhere (negbT eonlsthe) (negbFE ebelow).
+rewrite /generic_trajectories.update_open_cell_top.
+case o_eq : (outgoing e) => [ | g l]; rewrite -?o_eq; last first.
+(* If there are outgoing edges, this cell is treated as in the default case. *)
+  have := step_keeps_pw_default.
+  rewrite -/(open_cells_decomposition _ _) oe' -lelsto.
+  rewrite oe.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case: (opening_cells_aux _ _ _ _) => [nos lno].
+  case nosq : nos => [ | fno nos'] /=.
+    by rewrite /state_open_seq /= !cats0.
+  rewrite /state_open_seq /= catA -(catA (_ ++ _)) /= map_cat /= => it.
+  by rewrite map_cat /=.
+rewrite -/(open_cells_decomposition _ _) oe /=.
+have := step_keeps_pw_default; rewrite oe' -lelsto o_eq /=.
+have vle : valid_edge le (point e) by apply: open_edge_valid.
+have vhe : valid_edge he (point e) by apply: open_edge_valid.
+do 2 rewrite -/(vertical_intersection_point _ _).
+by rewrite pvertE // pvertE // !map_cat /= cats0.
+Qed.
+
+Lemma update_open_cell_side_limit_ok new_op new_lsto:
+  update_open_cell lsto e = (new_op, new_lsto) ->
+  p_x (point e) = left_limit lsto ->
+  point e <<< high lsto ->
+  point e >>> low lsto ->
+  all open_cell_side_limit_ok (rcons new_op new_lsto).
+Proof.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+move=> + pxq puh pal /=.
+have := (allP open_side_limit lsto lstoin).
+rewrite /open_cell_side_limit_ok /= => /andP[] lptsno /andP[] alllpts.
+move=> /andP[] slpts /andP[] athigh atlow.
+case lptsq : (left_pts lsto) lptsno => [ // | p1 [ | p2 lpts']] _ /=.
+  rewrite lptsq /= in athigh atlow.
+  (* contradiction with puh pal *)
+  have pxe1 : p_x (point e) = p_x p1 by rewrite pxq /left_limit lptsq.
+  have := strict_under_edge_lower_y pxe1 athigh; rewrite puh=> /esym.
+  have := under_edge_lower_y pxe1 atlow; rewrite (negbTE pal)=>/esym.
+  move/negbT; rewrite -ltNge=> /lt_trans /[apply].
+  by rewrite lt_irreflexive.
+have pxe2 : p_x (point e) = p_x p2.
+  rewrite (eqP (allP alllpts p2 _)); last by rewrite lptsq !inE eqxx orbT.
+  exact pxq.
+have p2lte : p_y p2 < p_y (point e).
+  have := lex_left_limit; rewrite lptsq /= => /andP[] + _.
+  by rewrite /lexPt pxe2 lt_irreflexive eqxx.
+case ogq : (outgoing e) => [ | fog ogs].
+  move=> [] <- <-; rewrite /= andbT /open_cell_side_limit_ok /=.
+  have pxel : p_x (point e) = p_x (last p2 lpts').
+    by rewrite pxq /left_limit lptsq.
+  move: (alllpts); rewrite /left_limit.
+  rewrite lptsq /= => /andP[] -> /andP[] /[dup]/eqP p2x -> ->.
+  rewrite lptsq /= in athigh.
+  have pxe1 : p_x (point e) = p_x p1.
+    by have := alllpts; rewrite lptsq /= => /andP[] /eqP ->.
+  have := strict_under_edge_lower_y pxe1 athigh; rewrite puh=> /esym ye1.
+  move: (pxel) => /eqP ->; rewrite ye1.
+  move: slpts; rewrite lptsq /= => /andP[] _ ->.
+  by rewrite athigh; move: atlow; rewrite lptsq /= => ->; rewrite p2lte !andbT.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq: (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+  have onn : outgoing e != [::] by rewrite ogq.
+  have := opening_cells_aux_absurd_case vlo vho onn oute.
+  by rewrite ogq oca_eq.
+move=> -[] <- <- /=.
+have ognn : outgoing e != [::] by rewrite ogq.
+have := opening_cells_last_left_pts vlo vho oute ognn puh; rewrite /=.
+rewrite ogq oca_eq /= => llnoq /=.
+move: (alllpts); rewrite /left_limit.
+rewrite lptsq /= => /andP[] _ /andP[] -> ->.
+move: pxq; rewrite /left_limit lptsq /= => ->; rewrite eqxx /=.
+rewrite p2lte /=.
+have := allP open_side_limit lsto lstoin => /andP[] _ /andP[] _.
+rewrite lptsq /= => /andP[] /andP[] _ -> /andP[] _ llo.
+have := opening_cells_seq_edge_shift _ vlo vho oca_eq.
+rewrite -ogq => /(_ oute') /= -[] <- _; rewrite llo andbT.
+have := opening_cells_aux_high vlo vho oute'; rewrite ogq oca_eq /= => highout.
+apply/andP; split.
+  have /oute'/eqP <- : high fno \in sort (@edge_below _) (outgoing e).
+    by rewrite ogq -highout inE eqxx.
+  by apply left_on_edge.
+have := opening_cells_aux_side_limit vlo vho (underWC pal) puh oute'.
+rewrite ogq oca_eq => /(_ _ _ erefl) allok.
+by apply/allP=> x xin; apply: (allP allok x); rewrite /= inE xin orbT.
+Qed.
+
+Lemma size_left_lsto :
+  p_x (point e) = lstx ->
+  point e >>> low lsto ->
+  point e <<= high lsto ->
+  (1 < size (left_pts lsto))%N.
+Proof.
+move=> pxhere pal puh.
+have lstok : open_cell_side_limit_ok lsto by apply: (allP open_side_limit).
+case lptsq : (left_pts lsto) => [ | p1 [ | p2 lpts]] //.
+  by move: lstok; rewrite /open_cell_side_limit_ok lptsq.
+have /andP[p1onh p1onl] : (p1 === high lsto) && (p1 === low lsto).
+  by move: lstok; rewrite /open_cell_side_limit_ok /left_limit lptsq /= eqxx /=.
+have /eqP samex : p_x (point e) = p_x p1.
+  by have := pxhere; rewrite lstxq /left_limit lptsq /=.
+suff : p_y (point e) < p_y (point e) by rewrite lt_irreflexive.
+have := same_pvert_y vho samex. 
+rewrite (on_pvert p1onh). 
+have := under_pvert_y vho; move: (puh)=> /[swap] -> /[swap] ->.
+move=> /le_lt_trans; apply.
+have := under_pvert_y vlo; move: (pal) => /[swap] ->.  
+rewrite (same_pvert_y vlo samex).
+by rewrite -ltNge (on_pvert p1onl).
+Qed.
+
+Lemma step_keeps_open_side_limit_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  all open_cell_side_limit_ok ((fc ++ nos) ++ lno :: lc).
+Proof.
+case oe: (open_cells_decomposition open (point e)) =>
+  [[[[[fc cc] lcc] lc] le] he].
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]]
+  := decomposition_main_properties oe exi.
+have [pal puh vle vhe allnct] :=
+  decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have oc_eq : opening_cells (point e) (outgoing e) le he = rcons nos lno.
+  by rewrite /opening_cells oca_eq.
+have := opening_cells_side_limit vle vhe (underWC pal) puh oute.
+rewrite /opening_cells oca_eq => oknew.
+rewrite -catA -cat_rcons !all_cat andbCA; apply/andP; split; first by [].
+have := open_side_limit; rewrite ocd -cat_rcons all_cat=> /andP[] -> /=.
+by rewrite all_cat /= => /andP[].
+Qed.
+
+Lemma step_keeps_open_side_limit :
+  all open_cell_side_limit_ok
+    (state_open_seq (step (Bscan fop lsto lop cls lstc lsthe lstx) e)).
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP=> [pxaway | /negbFE/eqP/[dup] pxhere/abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition (fop ++ lsto :: lop) (point e))=>
+    [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  by move: step_keeps_open_side_limit_default; rewrite /open oe oca_eq.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe: (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  have oe' :
+    open_cells_decomposition open (point e) =
+     (rcons fop lsto ++ fc', cc, lcc, lc, le, he).
+    move: adj rfo sval; rewrite /open -cat_rcons=> adj' rfo' sval'.
+    move: (open_cells_decomposition_cat adj' rfo' sval' (exi' eabove)).
+    by rewrite oe; apply.
+  move: step_keeps_open_side_limit_default; rewrite /open oe' oca_eq.
+  by rewrite /state_open_seq /= cat_rcons.
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite /state_open_seq /=.
+  rewrite -/(update_open_cell _ _).
+  case uoc_eq : (update_open_cell lsto e) => [nos lno] /=.
+  have pxhere' : p_x (point e) = left_limit lsto by rewrite pxhere.
+  have puh : point e <<< high lsto by rewrite -lstheq.
+  have nosok := update_open_cell_side_limit_ok uoc_eq pxhere' puh palstol.
+  rewrite -catA -cat_rcons !all_cat nosok /= -all_cat.
+  by apply: (all_sub _ open_side_limit); rewrite /open; subset_tac.
+move/negbFE:ebelow => ebelow.
+move/negbT: eonlsthe=> eonlsthe.
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+have exi2 : exists2 c, c \in lsto :: lop & contains_point' (point e) c.
+  by exists lsto; [subset_tac | rewrite /contains_point' palstol -lstheq].
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+have [fc'0 [lelsto _]] :=
+   last_step_situation oe pxhere eonlsthe ebelow.
+rewrite oe fc'0 lelsto cats0=> oe'.
+rewrite /generic_trajectories.update_open_cell_top.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe' exi.
+have lstok : open_cell_side_limit_ok lsto by apply: (allP open_side_limit).
+have slpts : (1 < size (left_pts lsto))%N.
+  by apply: size_left_lsto=> //; rewrite -lstheq.
+have [pal puh vle vhe ncont] :=
+    decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+case ogq : (outgoing e) => [ | fog ogs]; rewrite -?ogq; last first.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+  have ognn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vhe ognn oute.
+    by rewrite oca_eq.
+  have := step_keeps_open_side_limit_default; rewrite /open oe' oca_eq.
+  rewrite /state_open_seq -!catA /= !all_cat /= !all_cat=> /andP[] ->.
+  move=> /andP[] _ -> /=; rewrite andbT.
+  rewrite /open_cell_side_limit_ok /set_left_pts /=.
+  move: lstok=> /andP[].
+  rewrite pxhere lstxq /left_limit.
+  case lptsq: (left_pts lsto) slpts=> [// | p1 [ // | p2 ps]] _ _ /=.
+  move=> /andP[] /andP[] _ /[dup] /andP[] x2q _ ->.
+  move=> /andP[] /andP[] + -> /andP[] _.
+  have := opening_cells_seq_edge_shift oute' vlo vhe oca_eq.
+  rewrite eqxx /= => -[] <- _.
+  move=> _ ->.
+  have := lex_left_limit; rewrite lptsq /= => /andP[] + _.
+  rewrite /lexPt lt_neqAle pxhere lstxq /left_limit lptsq /= x2q /= => ->.
+  have /oute/eqP <- : high fno \in outgoing e.
+    have := opening_cells_aux_high vlo vhe oute'; rewrite oca_eq /=.
+    by rewrite -(mem_sort (@edge_below _))=> <-; rewrite inE eqxx.
+  by rewrite !andbT /=; apply: left_on_edge.
+(* Finished the case where there are some elements in outgoing e *)
+rewrite /state_open_seq/= !cats0.
+rewrite all_cat /=.
+move: (open_side_limit); rewrite /open ocd !all_cat /=.
+move=> /andP[] -> /andP[] _ /andP[] _ ->; rewrite /= ?andbT.
+case lptsq : (left_pts lsto) slpts => [ | p1 [ | p2 lpts]] // _.
+rewrite /open_cell_side_limit_ok /=.
+have pxe : p_x (point e) = p_x (last p2 lpts).
+  by rewrite pxhere lstxq /left_limit lptsq /=.
+rewrite pxe eqxx /=.
+move: (lstok); rewrite /open_cell_side_limit_ok /left_limit lptsq /=.
+move=> /andP[] /andP[] /[dup] /eqP p1x -> /andP[] -> ->.
+move=> /andP[] /andP[] -> -> /andP[] p1on ->.
+rewrite /= !andbT.
+have p1e : p1 = (point e).
+  have /eqP samex : p_x (point e) = p_x p1.
+    by have := pxhere; rewrite lstxq /left_limit lptsq /= p1x.
+  have /eqP samey : p_y (point e) = p_y p1.
+    have eonlsthe' : point e === high lsto.
+      by apply: under_above_on=> //; rewrite -lstheq // ?underW.
+    by have /eqP := on_edge_same_point eonlsthe' p1on samex.
+  by apply/esym/(@eqP [eqType of pt]); rewrite pt_eqE samex samey.
+rewrite p1e /generic_trajectories.pvert_y subrr -strict_under_pvert_y //.
+by rewrite puh -pxe pvert_on.
+Qed.
+
+Lemma disjoint_open : {in open &, disjoint_open_cells R}.
+Proof.
+by apply: disoc=> //; have := pwo; rewrite /= => /andP[].
+Qed.
+
+Lemma step_keeps_open_disjoint :
+  {in state_open_seq (step (Bscan fop lsto lop cls lstc lsthe lstx) e) &,
+     disjoint_open_cells R}.
+Proof.
+have := step_keeps_invariant1; rewrite /invariant1/inv1_seq. 
+set s' := (state_open_seq _) => -[clae' [sval' [adj' [cbtom' srf']]]].
+have := step_keeps_pw; rewrite -/s' => /= /andP[] _ pw'.
+have := step_keeps_open_side_limit; rewrite -/s'=> ok'.
+apply: disoc=>//.
+Qed.
+
+Section arbitrary_closed.
+
+Variable old_closed : seq cell.
+
+Hypothesis disjoint_open_old_closed :
+  {in open & old_closed, disjoint_open_closed_cells R}.
+
+Hypothesis disjoint_old_closed : {in old_closed &, disjoint_closed_cells R}.
+Hypothesis old_closed_right_limit :
+  {in old_closed, forall c, right_limit c <= p_x (point e)}.
+
+Lemma step_keeps_disjoint_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) :=
+      opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+    let closed := closing_cells (point e) cc in
+     let last_closed := close_cell (point e) lcc in
+     let closed_cells := old_closed ++ rcons closed last_closed in
+  {in closed_cells &, disjoint_closed_cells R} /\
+  {in fc ++ nos ++ lno :: lc & closed_cells,
+    disjoint_open_closed_cells R}.
+Proof.
+case oe : (open_cells_decomposition open (point e)) =>
+   [[[[[fc  cc] lcc] lc] le] he].
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct
+     [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe ncont]
+ := connect_properties cbtom adj rfo sval bet_e ocd all_nct all_ct
+  lcc_ctn flcnct.
+have allcont : all (contains_point (point e)) (rcons cc lcc).
+  by rewrite -cats1 all_cat /= lcc_ctn !andbT; apply/allP.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+move=> closed last_closed closed_cells.
+have svalcc : seq_valid (rcons cc lcc) (point e).
+   apply/allP=> c cin; apply: (allP sval); rewrite ocd !mem_cat.
+   move: cin; rewrite mem_rcons inE.
+   by move=> /orP[/eqP |] ->; rewrite ?inE ?eqxx ?orbT //.
+have adjcc : adjacent_cells (rcons cc lcc).
+  by move: adj; rewrite ocd -cat_rcons =>/adjacent_catW[] _ /adjacent_catW[].
+have rfocc : s_right_form (rcons cc lcc).
+   apply/allP=> c cin; apply: (allP rfo); rewrite ocd !mem_cat.
+   move: cin; rewrite mem_rcons inE.
+   by move=> /orP[/eqP |] ->; rewrite ?inE ?eqxx ?orbT //.
+have closed_map : closing_cells (point e) (rcons cc lcc) =
+       rcons [seq close_cell (point e) c | c <- cc]
+          (close_cell (point e) lcc).
+  by rewrite /closing_cells map_rcons.
+have ccok : all open_cell_side_limit_ok (rcons cc lcc).
+    apply/allP=> c cin; apply: (allP open_side_limit); rewrite ocd !mem_cat.
+  move: cin; rewrite mem_rcons inE.
+   by move=> /orP[/eqP |] ->; rewrite ?inE ?eqxx ?orbT //.
+have := closing_cells_side_limit' rfocc svalcc adjcc ccok allcont.
+rewrite head_rcons pal last_rcons puh=> /(_ isT isT).
+rewrite [X in all _ X]closed_map=> /allP cl_sok.
+have oldcl_newcl :
+  {in old_closed & closing_cells (point e) (rcons cc lcc),
+     disjoint_closed_cells R}.
+  move=> c1 c2 c1in; rewrite closed_map -map_rcons=> /mapP[c2' c2'in c2eq].
+  have c2'open : c2' \in open.
+    by rewrite ocd -cat_rcons !mem_cat c2'in !orbT.
+    have vc2 : valid_cell c2' (point e) by apply/andP/(allP sval).
+  right; rewrite /c_disjoint=> q; apply/negP=> /andP[inc1 inc2].
+  rewrite c2eq in inc2.
+   case/negP:(disjoint_open_old_closed c2'open c1in q).
+   rewrite inc1 andbT.
+  apply:(close'_subset_contact vc2 _ inc2).
+  by move: (cl_sok c2); rewrite c2eq; apply; rewrite -map_rcons; apply: map_f.
+split.
+  move=> c1 c2; rewrite !mem_cat.
+  move=> /orP[c1old | c1new] /orP[c2old | c2new].
+         by apply: disjoint_old_closed.
+      by apply: oldcl_newcl; rewrite // closed_map.
+    apply: c_disjoint_eC; apply: oldcl_newcl; first by [].
+    by rewrite closed_map.
+  rewrite -map_rcons in c1new c2new.
+  move: c1new c2new => /mapP[c1' c1'in c1eq] /mapP[c2' c2'in c2eq].
+  have c1'open : c1' \in open by rewrite ocd -cat_rcons !mem_cat c1'in orbT.
+  have c2'open : c2' \in open by rewrite ocd -cat_rcons !mem_cat c2'in orbT.
+  have vc1 : valid_cell c1' (point e) by apply/andP/(allP sval).
+  have vc2 : valid_cell c2' (point e) by apply/andP/(allP sval).
+  have [/eqP c1c2 | c1nc2] := boolP(c1' == c2').
+    by left; rewrite c1eq c2eq c1c2.
+  right=> q; apply/negP=> /andP[inc1 inc2].
+  case: (disjoint_open c1'open c2'open)=> [/eqP | /(_ q)]. 
+    by rewrite (negbTE c1nc2).
+  move=> /negP[].
+  rewrite c1eq in inc1; rewrite c2eq in inc2.
+  rewrite (close'_subset_contact vc1 _ inc1); last first.
+    by apply: cl_sok; rewrite -map_rcons; apply: map_f.
+  rewrite (close'_subset_contact vc2 _ inc2) //.
+  by apply: cl_sok; rewrite -map_rcons; apply: map_f.
+rewrite -leq in vle; rewrite -heq in vhe.
+move=> c1 c2; rewrite -cat_rcons 2!mem_cat orbCA=> /orP[c1newo |c1old] c2in.
+  have rlc2 : right_limit c2 <= p_x (point e).
+    move: c2in; rewrite /closed_cells mem_cat.
+    move=> /orP[/old_closed_right_limit // |].
+    rewrite -map_rcons=> /mapP[c2' c2'in ->].
+    by rewrite close_cell_right_limit //; apply/andP/(allP svalcc).
+  move=> q; rewrite inside_open'E inside_closed'E; apply/negP.
+  move=> /andP[] /andP[] _ /andP[] _ /andP[] + _
+     /andP[] _ /andP[] _ /andP[] _ +.
+  have := opening_cells_left oute vle vhe.
+  rewrite /opening_cells oca_eq=> /(_ _ c1newo) => -> peq qrlc2.
+  by move: rlc2; rewrite leNgt=>/negP[]; apply: (lt_le_trans peq).
+have c1open : c1 \in open by rewrite ocd -cat_rcons !mem_cat orbCA c1old orbT.
+move: c2in; rewrite /closed_cells mem_cat=>/orP[c2old |].
+  by apply: disjoint_open_old_closed.
+rewrite -map_rcons=> /mapP[c2' c2'in c2eq] q; apply/negP=> /andP[] inc1 inc2.
+have c2'open : c2' \in open by rewrite ocd -cat_rcons !mem_cat c2'in !orbT.
+have [c1eqc2 | disjc1c2] := disjoint_open c1open c2'open.
+  case (negP (ncont _ c1old)).
+  rewrite c1eqc2.
+  by move: c2'in; rewrite mem_rcons inE=> /orP[/eqP -> | /all_ct].
+move: (disjc1c2 q); rewrite inc1 //=.
+have vc2 : valid_cell c2' (point e) by apply/andP/(allP sval).
+rewrite c2eq in inc2.
+rewrite (close'_subset_contact vc2 _ inc2) //.
+by apply: cl_sok; rewrite -map_rcons; apply: map_f.
+Qed.
+
+End arbitrary_closed.
+
+Lemma bottom_edge_below : {in cell_edges open, forall g, bottom <| g}.
+Proof.
+move: pwo=> /= /andP[] /allP pwo' _ g.
+rewrite (cell_edges_sub_high cbtom adj) inE=> /orP[/eqP -> | /pwo' //].
+by apply: edge_below_refl.
+Qed.
+
+Definition state_closed_seq (s : scan_state) := 
+  rcons (sc_closed s) (lst_closed s).
+
+Lemma adjacent_update_open_cell new_op new_lsto:
+  update_open_cell lsto e = (new_op, new_lsto) ->
+  low lsto = low (head dummy_cell (rcons new_op new_lsto)) /\
+  high lsto = high (last dummy_cell (rcons new_op new_lsto)) /\
+  adjacent_cells (rcons new_op new_lsto).
+Proof.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case o_eq : (outgoing e) => [ | g os].
+  by move=> [] <- <- /=.
+rewrite -o_eq.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [[ // | fno nos] lno] [] <- <-.
+  have onn : outgoing e != [::] by rewrite o_eq.
+  by have := opening_cells_aux_absurd_case vlo vho onn oute; rewrite oca_eq.
+rewrite /= last_rcons.
+have [/= A ->] := adjacent_opening_aux vlo vho oute' oca_eq.
+split;[ | split]=> //=.
+  have := opening_cells_aux_high_last vlo vho oute'.
+  by rewrite oca_eq /=.
+by move: A; case : (nos).
+Qed.
+
+Lemma low_all_edges c evs: c \in open -> low c \in all_edges open evs.
+Proof. by move=> cin; rewrite !mem_cat map_f ?orbT. Qed.
+
+Lemma high_all_edges c evs: c \in open -> high c \in all_edges open evs.
+Proof. by move=> cin; rewrite !mem_cat map_f ?orbT. Qed.
+
+Lemma update_open_cell_right_form  new_op new_lsto:
+  update_open_cell lsto e = (new_op, new_lsto) ->
+  point e <<< high lsto ->
+  point e >>> low lsto ->
+  s_right_form (rcons new_op new_lsto).
+Proof.
+move=> + puho palo.
+have noco : below_alt (low lsto) (high lsto).
+  apply: noc; first by apply: low_all_edges; rewrite /open; subset_tac.
+  by apply: high_all_edges; rewrite /open; subset_tac.
+have rflsto : low lsto <| high lsto.
+  by apply: (edge_below_from_point_above noco vlo vho (underWC _)).
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+have srt : path (@edge_below _) (low lsto) (sort (@edge_below _) (outgoing e)).
+  apply: (sorted_outgoing vlo vho palo puho oute).
+  apply: sub_in2 noc=> x; rewrite 2!inE => /orP[/eqP ->|/orP[/eqP ->|]] //.
+  by apply: subo.
+case ogeq : (outgoing e) => [ | g os].
+  move=> [] <- <- /=; rewrite andbT.
+  by apply: (edge_below_from_point_above noco vlo vho (underWC _)).
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+  move=> [] <- <- /=; rewrite andbT.
+  rewrite -ogeq /= in oca_eq.
+  have /= := opening_cells_aux_right_form (underWC palo)
+  puho vlo vho loin hoin rflsto oute' noc subo' srt oca_eq.
+  by rewrite andbT.
+move=> [] <- <- /=.
+rewrite -ogeq /= in oca_eq.
+by have /= := opening_cells_aux_right_form (underWC palo)
+puho vlo vho loin hoin rflsto oute' noc subo' srt oca_eq.
+Qed.
+
+Lemma update_open_cell_end_edge new_op new_lsto :
+  end_edge_ext bottom top (low lsto) future_events ->
+  end_edge_ext bottom top (high lsto) future_events ->
+  valid_edge (low lsto) (point e) ->
+  valid_edge (high lsto) (point e) ->
+  update_open_cell lsto e = (new_op, new_lsto) ->
+  {in rcons new_op new_lsto, forall x,
+    end_edge_ext bottom top (low x) future_events &&
+    end_edge_ext bottom top (high x) future_events}.
+Proof.
+move=> endl endh vl vh.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogeq : (outgoing e) => [ | fog ogs].
+  move=> [] <- <- /= x; rewrite inE=> /eqP -> /=.
+  by rewrite endl endh.
+move: cle; rewrite /= => /andP[] cloe _.
+have cllsto := opening_cells_close vl vh oute endl endh cloe => {cloe}.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+  have onn : outgoing e != [::] by rewrite ogeq.
+  have := opening_cells_aux_absurd_case vlo vho onn oute.
+  by rewrite ogeq oca_eq.
+move=> -[] <- <- /= x; rewrite inE=> /orP[/eqP -> | xin].
+  by rewrite /=; apply: (allP cllsto); rewrite /opening_cells ogeq oca_eq /=;
+   subset_tac.
+by apply: (allP cllsto); rewrite /opening_cells ogeq oca_eq /= inE xin orbT.
+Qed.
+
+Lemma update_open_cell_end_edge' c nos lno :
+  valid_edge (low c) (point e) ->
+  valid_edge (high c) (point e) ->
+  update_open_cell c e = (nos, lno) ->
+  close_alive_edges (rcons nos lno) future_events =
+  close_alive_edges (opening_cells (point e) (outgoing e)
+      (low c) (high c)) future_events.
+Proof.
+move=> vlc vhc; rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogeq : (outgoing e) => [ | fog ogs].
+  move=> -[] <- <- /=.
+  rewrite /opening_cells /=.
+  rewrite -/(vertical_intersection_point _ _) /= pvertE //.
+  by rewrite -/(vertical_intersection_point _ _) pvertE.
+rewrite /opening_cells /=.
+have onn : outgoing e != [::] by rewrite ogeq.
+have := opening_cells_aux_absurd_case vlc vhc onn oute; rewrite ogeq.
+rewrite -/(opening_cells_aux _ _ _ _).
+by case oca_eq : (opening_cells_aux _ _ _ _) => [[ | ? ?] ?] + [] <- <- /=.
+Qed.
+
+Lemma update_open_cell_valid c nos lno :
+  valid_edge (low c) (point e) ->
+  valid_edge (high c) (point e) ->
+  update_open_cell c e = (nos, lno) ->
+  seq_valid (rcons nos lno) p = 
+  seq_valid (opening_cells (point e) (outgoing e) (low c) (high c)) p.
+Proof.
+move=> vlc vhc; rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogeq : (outgoing e) => [ | fog ogs].
+  move=> -[] <- <- /=.
+  rewrite /opening_cells /= -/(vertical_intersection_point _ _) pvertE //.
+  by rewrite -/(vertical_intersection_point _ _) pvertE.
+rewrite /opening_cells /=.
+have onn : outgoing e != [::] by rewrite ogeq.
+have := opening_cells_aux_absurd_case vlc vhc onn oute; rewrite ogeq.
+rewrite -/(opening_cells_aux _ _ _ _).
+by case oca_eq : (opening_cells_aux _ _ _ _) => [[ | ? ?] ?] + [] <- <- /=.
+Qed.
+
+Lemma lex_left_pts_inf' :
+  let '(fc, _, _, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+  let '(nos, lno) :=
+    opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he in
+    {in fc ++ nos ++ lno :: lc,
+      forall c, lexePt  (bottom_left_corner c) (point e)}.
+Proof.
+case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have [ocd [_ [_ [_ [_ [leq [heq [lein hein]]]]]]]]:=
+  decomposition_main_properties oe exi.
+have [pal puh vle vhe A']:= decomposition_connect_properties rfo sval adj cbtom
+  bet_e oe.
+have sublehe : {subset rcons (le :: sort (@edge_below _) (outgoing e)) he <=
+                  all_edges open (e :: future_events)}.
+  move=> x; rewrite mem_rcons inE => /orP[/eqP -> | ].
+    by rewrite /all_edges; subset_tac.
+  rewrite inE=> /orP[/eqP -> | ].
+    by rewrite /all_edges; subset_tac.
+  by apply: subo'.
+have noc2:
+   {in rcons (le :: sort (@edge_below _) (outgoing e)) he &, no_crossing R}.
+  by move=> x y xin yin; apply: noc; apply: sublehe.
+move=> x; rewrite !(mem_cat, inE) => /orP[xfc | ].
+  by apply: lexPtW; apply: btom_left_corners; rewrite ocd; subset_tac.
+rewrite orbA=> /orP[xin | xlc]; last first.
+  apply: lexPtW.
+  apply: btom_left_corners; rewrite ocd; subset_tac.
+have noclh : below_alt le he.
+  by apply: noc2; rewrite ?(mem_rcons, inE) eqxx ?orbT.
+have lebhe : le <| he.
+  apply: (edge_below_from_point_above noclh vle vhe (underWC pal) puh).
+have := opening_cells_last_lexePt oute (underWC pal) puh vle vhe noc2 lebhe.
+rewrite /opening_cells oca_eq; apply.
+by rewrite mem_rcons inE orbC.
+Qed.
+
+Lemma step_keeps_btom_left_corners_default q :
+  lexPt (point e) q ->
+  let '(fc, _, _, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+  let '(nos, lno) :=
+    opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he in
+    {in fc ++ nos ++ lno :: lc, forall c, lexPt  (bottom_left_corner c) q}.
+Proof.
+move=> lexq.  
+case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+case oca_eq: (opening_cells_aux _ _ _ _) => [nos lno].
+have := lex_left_pts_inf'; rewrite oe oca_eq => main.
+by move=> x xin; apply: lexePt_lexPt_trans lexq; apply: main.
+Qed.
+
+Lemma leftmost_points_max :
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  left_limit (start_open_cell bottom top) =
+  max (p_x (left_pt bottom)) (p_x (left_pt top)).
+Proof.
+rewrite /start_open_cell/generic_trajectories.start_open_cell /leftmost_points => /andP[] /=.
+rewrite R_ltb_lt.
+case: ltrP => cmpl.
+  rewrite -/(vertical_intersection_point _ _).
+  case peq: (vertical_intersection_point (left_pt top) bottom) => [p' | //].
+  move=> _ /andP[] samex _ /=.
+  move: peq.
+  rewrite /vertical_intersection_point/generic_trajectories.vertical_intersection_point.
+  by case: ifP=> // ve [] <-.
+rewrite -/(vertical_intersection_point _ _).
+case peq: (vertical_intersection_point (left_pt bottom) top)=> [p' | //] _.
+by case: ifP=> [/eqP A | B]; move=> /andP[].
+Qed.
+
+Lemma trial1 c1 c2 :
+  below_alt (high c1) (low c2) ->
+  open_cell_side_limit_ok c1 ->
+  open_cell_side_limit_ok c2 ->
+  valid_edge (high c1) (point e) ->
+  valid_edge (low c2) (point e) ->
+  pvert_y (point e) (high c1) < pvert_y (point e) (low c2) ->
+  o_disjoint c1 c2.
+Proof.
+move=> noc12 ok1 ok2 vhc1 vlc2 cmpc1c2 q; apply/andP=>-[].
+move=> /andP[]inc1 _ /andP[] inc2 /andP[] str2 _.
+have /andP[_ vhc1q] := inside_open_cell_valid ok1 inc1.
+have /andP[vlc2q _] := inside_open_cell_valid ok2 inc2.
+move: (inc1)=> /andP[] /andP[] _ qh1 _.
+have := transport_above_edge noc12 vhc1 vlc2 vhc1q vlc2q cmpc1c2 str2.
+rewrite /point_under_edge.
+by rewrite qh1.
+Qed.
+
+Lemma trial2 c1 c2 :
+  high c1 <| low c2 ->
+  open_cell_side_limit_ok c1 ->
+  open_cell_side_limit_ok c2 ->
+  valid_edge (high c1) (point e) ->
+  valid_edge (low c2) (point e) ->
+  o_disjoint c1 c2.
+Proof.
+move=> c1bc2 ok1 ok2 v1 v2 q; apply/negP=> /andP[].
+move=>/andP[] /andP[] /andP[] _ qbh1 /andP[] _ inx /andP[] _ stricterx.
+have inx' : left_limit c1 < p_x q <= open_limit c1.
+  by rewrite stricterx inx.
+move: inx' {inx stricterx} => /(valid_high_limits ok1) vqhc1.
+move=>/andP[] /andP[] _ /andP[] _ inx /andP[] qalc2 stricterx.
+have inx' : left_limit c2 < p_x q <= open_limit c2.
+  by rewrite stricterx inx.
+move: inx' {inx stricterx} => /(valid_low_limits ok2) vqlc2.
+rewrite (under_pvert_y vqlc2) -ltNge in qalc2.
+rewrite -/(point_under_edge _ _) in qbh1.
+rewrite (under_pvert_y vqhc1) in qbh1.
+have /pvert_y_edge_below : pvert_y q (low c2) < pvert_y q (high c1).
+  by apply: (lt_le_trans qalc2 qbh1).
+by move=> /(_ vqlc2 vqhc1) /negP; apply.
+Qed.
+
+Lemma lexPt_left_pt_strict_under_edge_to_p_x (pt : pt) g:
+  valid_edge g pt -> lexPt (left_pt g) pt -> pt <<< g ->
+  p_x (left_pt g) < p_x pt.
+Proof.
+move=> vg.
+rewrite /lexPt eq_sym=> /orP[ | /andP[] samex]; first by [].
+have := same_pvert_y vg samex.
+rewrite (on_pvert (left_on_edge g))=> <-.
+rewrite ltNge le_eqVlt negb_or andbC.
+by move=> /[swap]; rewrite strict_under_pvert_y // => ->.
+Qed.
+
+Lemma pvert_y_right_pt (g : edge) : pvert_y (right_pt g) g = p_y (right_pt g).
+Proof. apply/on_pvert/right_on_edge. Qed.
+
+Lemma inside_box_sorted_le :
+  sorted <=%R [seq pvert_y (point e) (high c) | c <- extra_bot :: open].
+Proof.
+have adj' : adjacent_cells (extra_bot :: open).
+  rewrite /=; move: cbtom=> /andP[] /andP[]; case: (open) adj => // o1 os + _.
+  by move=> /= -> /eqP ->; rewrite eqxx.
+apply adjacent_right_form_sorted_le_y => //=.
+  rewrite andbb; apply/andP; split=> //.
+  by apply: (inside_box_valid_bottom_top inbox_e)=> //; rewrite inE eqxx.
+by rewrite edge_below_refl.
+Qed.
+
+Lemma head_cat [T : eqType] (s1 s2 : seq T) (a : T):
+   s1 != nil -> head a (s1 ++ s2) = head a s1.
+Proof. by case : s1 => [ | b s1]. Qed.
+
+(* This is not used, just now. *)
+Lemma left_limit_closing_cells (cc : seq cell) (p1 : pt) :
+  adjacent_cells cc -> seq_valid cc p1 ->
+  p1 >>> low (head_cell cc) -> p1 <<< high (last_cell cc) ->
+  all (contains_point p1) cc ->
+  [seq left_limit i | i <- closing_cells p1 cc] = [seq left_limit i | i <- cc].
+Proof.
+move=> adjcc svalcc pale puhe allcont.
+rewrite /closing_cells.
+rewrite -map_comp; rewrite -eq_in_map /close_cell => -[] ls rs lo hi cin /=.
+move: (allP svalcc _ cin) => /= /andP[] vloc vhic.
+by rewrite (pvertE vloc) (pvertE vhic).
+Qed.
+
+Definition set_right_pts (c : cell) (l : seq pt) :=
+  Bcell (left_pts c) l (low c) (high c).
+
+Lemma inside_closed_set_right_pts (c : cell) l q:
+  last dummy_pt (right_pts c) = last dummy_pt l ->
+  inside_closed' q c = inside_closed' q (set_right_pts c l).
+Proof.
+rewrite /inside_closed' /set_right_pts /inside_closed_cell /contains_point /=.
+by rewrite /right_limit /= => ->.
+Qed.
+
+Lemma inside_closed'_update q1 q:
+  inside_closed' q lstc = inside_closed' q (update_closed_cell lstc q1).
+Proof.
+have samer : last dummy_pt (right_pts lstc) =
+             last dummy_pt (belast (head dummy_pt (right_pts lstc))
+                             (behead (right_pts lstc)) ++
+                           [:: q1; last dummy_pt (right_pts lstc)]).
+  move: non_empty_right.
+  elim/last_ind : (right_pts lstc) => [ // | rpts lr _] _ /=.
+  by rewrite !last_cat /=.
+rewrite /update_closed_cell.
+have := inside_closed_set_right_pts q samer.
+rewrite /set_right_pts /=.
+by rewrite /set_right_pts /= => <- //.
+Qed.
+
+Lemma update_open_cellE1 c c1 :
+ valid_edge (low c) (point e) ->
+ valid_edge (high c) (point e) ->
+ open_cell_side_limit_ok c ->
+ p_x (point e) = left_limit c ->
+ (1 < size (left_pts c))%N ->
+ point e >>> low c ->
+ point e <<< high c ->
+ c1 \in (update_open_cell c e).1 ->
+ exists2 c', c' \in (opening_cells_aux (point e) 
+                        (sort (@edge_below _) (outgoing e)) (low c)
+    (high c)).1 &
+     c1 = c' \/
+     exists2 l, last dummy_pt l = last dummy_pt (left_pts c') &
+     c1 = set_left_pts c' l.
+Proof.
+move=> vle vhe cok xcond sl pal puh.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogq : (outgoing e) => [ | fog ogs] //=.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [ [// | fno nos] lno] /=.
+rewrite inE => /orP[/eqP -> | ].
+  exists fno; first by rewrite inE eqxx.
+  right; exists (point e :: behead (left_pts c)).
+    case lptsq : (left_pts c) sl => [ // | p1 [ // | p2 lpts]] _ /=.
+    move: cok; rewrite /open_cell_side_limit_ok=> /andP[] _ /andP[] allx.
+    move=> /andP[] _ /andP[] _; rewrite lptsq /=.
+    have oute2 : {in (fog :: ogs),
+        forall g, left_pt g == point e}.
+      by rewrite -ogq; exact oute.
+    have oute3 : {in sort (@edge_below _) (fog :: ogs),
+        forall g, left_pt g == point e}.
+      by move=> g; rewrite mem_sort; apply: oute2.
+    have := opening_cells_side_limit vle vhe (underWC pal) puh oute2.
+    rewrite /opening_cells oca_eq=> /allP /(_ fno).
+    rewrite inE eqxx=> /(_ isT)=> /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+    have := opening_cells_first_left_pts (high c) vle _ pal.
+    rewrite ogq oca_eq => /(_ isT) /= -> /=.
+    have [_ /= ] := adjacent_opening_aux vle vhe oute3 oca_eq => ->.
+    rewrite /=.
+    move=> /on_edge_same_point /[apply] /=.
+    rewrite xcond /left_limit lptsq /= eqxx => /(_ isT) /eqP ->.
+    by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+  by [].
+move=> c1in; exists c1; first by rewrite inE c1in orbT.
+by left.
+Qed.
+
+Lemma update_open_cellE2 c :
+ valid_edge (low c) (point e) ->
+ valid_edge (high c) (point e) ->
+ open_cell_side_limit_ok c ->
+ p_x (point e) = left_limit c ->
+ (1 < size (left_pts c))%N ->
+ point e >>> low c ->
+ point e <<< high c ->
+ (update_open_cell c e).2 =
+ (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) (low c)
+    (high c)).2 \/
+  (update_open_cell c e).2 =
+  (set_left_pts c (head dummy_pt
+       (left_pts c) :: point e :: behead (left_pts c))).
+Proof.
+move=> vle vhe cok xcond sl pal puh.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogq : (outgoing e)=> [ | fog ogs]; first by right.
+left; rewrite -ogq.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [ [ | fno nos] lno] //=.
+have ognn : outgoing e != [::] by rewrite ogq.
+have := opening_cells_aux_absurd_case vle vhe ognn oute.
+by rewrite oca_eq.
+Qed.
+
+Lemma inside_open'_set_pts (c : cell) l1 l2 q :
+   last dummy_pt l1 = last dummy_pt (left_pts c) ->
+   inside_open' q c = inside_open' q (set_pts c l1 l2).
+Proof.
+move=> same_lim.
+rewrite /inside_open' /inside_open_cell /contains_point /left_limit /=.
+by rewrite same_lim.
+Qed.
+
+Lemma oc_disjoint_set_left_pts c1 c2 l :
+  last dummy_pt l = last dummy_pt (left_pts c1) ->
+  oc_disjoint c1 c2 ->
+  oc_disjoint (set_left_pts c1 l) c2.
+Proof.
+move=> eql ref q.
+rewrite -inside_open'_set_pts; last by apply/esym.
+exact: (ref q).
+Qed.
+
+Let step_keeps_disjoint_default' :=
+  step_keeps_disjoint_default disjoint_open_closed disjoint_closed
+  closed_right_limit.
+
+Lemma appE {T : Type} (l1 l2 : seq T) : app l1 l2 = cat l1 l2.
+Proof. by elim: l1 => [ | a l1 /= ->]. Qed.
+
+Lemma step_keeps_disjoint :
+  let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {in state_closed_seq  s' &, disjoint_closed_cells R} /\
+  {in state_open_seq s' & state_closed_seq s',
+    disjoint_open_closed_cells R}.
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP=> [pxaway |/negbFE/eqP /[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition open (point e)) =>
+     [[[[[fc  cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  rewrite /state_closed_seq /state_open_seq /=.
+  rewrite -[X in rcons X _]cat_rcons rcons_cat /=.
+  have := step_keeps_disjoint_default'; rewrite oe oca_eq /=.
+  move=> [] A B; split;[apply: A | ].
+  by rewrite -catA; apply: B.
+case: ifP=> [eabove | ebelow].
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  have oe' :
+    open_cells_decomposition open (point e) =
+     (rcons fop lsto ++ fc', cc, lcc, lc, le, he).
+    move: adj rfo sval; rewrite /open -cat_rcons=> adj' rfo' sval'.
+    move: (open_cells_decomposition_cat adj' rfo' sval' (exi' eabove)).
+    by rewrite oe; apply.
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe' exi.
+  have [pal puh vle vhe _]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+  rewrite /state_open_seq /state_closed_seq /= rcons_cat.
+  rewrite !appE.
+  rewrite -(cat_rcons lsto) -catA -(cat_rcons lno).
+  have := step_keeps_disjoint_default'.
+  by rewrite oe' oca_eq /= -(cat_rcons lno) -(cat_rcons lstc).
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite -/(open_cells_decomposition _ _).
+  have oe : open_cells_decomposition open (point e) =
+          (fop, [::], lsto, lop, low lsto, high lsto).
+    by rewrite open_cells_decomposition_single=> //; rewrite -lstheq.
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+  rewrite /state_open_seq /state_closed_seq /=.
+  rewrite -/(update_open_cell _ _).
+  case uoc_eq : (update_open_cell lsto e) => [nos lno] /=.
+  split.
+    have lstcn : lstc \notin cls.
+      by move: uniq_closed; rewrite rcons_uniq=> /andP[].
+    have lstcin : lstc \in rcons cls lstc by rewrite mem_rcons inE eqxx.
+    have in' c : c \in cls -> c \in rcons cls lstc.
+      by move=> cin; rewrite mem_rcons inE cin orbT.
+    have main c1 q: 
+         c_disjoint c1 lstc -> 
+         c_disjoint c1 (update_closed_cell lstc q).
+      by move=> /[swap] q1 /(_ q1); rewrite -inside_closed'_update.
+    move=> c1 c2; rewrite !mem_rcons !inE !(orbC _ (_ \in cls)).
+    move=>/orP[c1in | /eqP ->] /orP[c2in | /eqP ->]; last by left.
+        by apply: disjoint_closed; rewrite mem_rcons inE ?c1in ?c2in orbT.
+      right; apply: main; case: (disjoint_closed (in' _ c1in) lstcin)=> //.
+      by move: lstcn=> /[swap] <-; rewrite c1in.
+    apply: c_disjoint_eC; right; apply: main.
+    case: (disjoint_closed (in' _ c2in) lstcin)=> //.
+    by move: lstcn=> /[swap] <-; rewrite c2in.
+  have main c : 
+     oc_disjoint c lstc ->
+     oc_disjoint c (update_closed_cell lstc (point e)).
+    by rewrite /oc_disjoint=> /[swap] q /(_ q); rewrite -inside_closed'_update.
+  have := step_keeps_disjoint_default'.
+  have lstok : open_cell_side_limit_ok lsto.
+    by apply: (allP open_side_limit); rewrite /open mem_cat /= inE eqxx orbT.
+  have pxo : p_x (point e) = left_limit lsto by rewrite -lstxq.
+  have slpts : (1 < size (left_pts lsto))%N.
+    by apply: size_left_lsto=> //; rewrite -lstheq; apply: underW.
+  have puh : point e <<< high lsto by rewrite -lstheq.
+  have := update_open_cellE1 vlo vho lstok pxo slpts palstol puh.
+  rewrite uoc_eq /=.
+  have := update_open_cellE2 vlo vho lstok pxo slpts palstol puh.
+  rewrite uoc_eq /=.
+  rewrite oe.  
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos' lno'] /= helper2 helper1.
+  move=> [] _ helper3.
+  move=> c1 c2 c1in; rewrite mem_rcons inE => /orP[/eqP -> | ].
+    apply: main.
+    move: c1in; rewrite -!catA /= mem_cat=> /orP[c1f |].
+      apply: disjoint_open_closed; last by rewrite mem_rcons inE eqxx.
+      by rewrite /open mem_cat c1f.
+    rewrite mem_cat=> /orP[].
+      move=>/helper1 [c1' c1'in]=>- [-> | ].
+        by apply: helper3; rewrite !mem_cat ?mem_rcons ?c1'in ?inE ?eqxx ?orbT.
+      move=>[l lq ->] q.
+      suff -> : inside_open' q (set_left_pts c1' l) = inside_open' q c1'.
+        by apply: (helper3 c1' lstc _ _ q);
+            rewrite !mem_cat ?mem_rcons ?c1'in ?inE ?eqxx ?orbT.
+      by apply/esym/inside_open'_set_pts/esym.
+    rewrite inE=> /orP[/eqP -> | ].
+      case: helper2=> [ -> | -> ].
+        by apply: helper3; rewrite !mem_cat ?mem_rcons !inE !eqxx ?orbT.
+      set W := (set_left_pts _ _).    
+      move=> q.
+      suff -> : inside_open' q W = inside_open' q lsto.
+        by apply: disjoint_open_closed;
+         rewrite ?mem_rcons ?mem_cat /= ?inE ?eqxx ?orbT.
+      apply/esym/inside_open'_set_pts.
+      have := size_left_lsto pxhere palstol (underW puh).
+      by case : (left_pts lsto) => [ | p1 [ | p2 lpts]].
+    move=> c1f.
+    by apply: disjoint_open_closed;
+         rewrite ?mem_cat ?mem_rcons ?inE ?c1f ?eqxx ?orbT.
+  move=> c2in.
+  move: c1in; rewrite -catA !mem_cat /= => /orP[c1f |].
+    by apply: disjoint_open_closed;
+       rewrite ?mem_cat ?mem_rcons ?inE ?c1f ?eqxx ?c2in ?orbT.
+  move=> /orP[/helper1 [c1' c1no'] |].
+    move=> [-> | [l lq -> q] ].  
+      by apply: helper3; rewrite !(mem_rcons, mem_cat, inE) ?c1no' ?c2in ?orbT.
+    suff -> : inside_open' q (set_left_pts c1' l) = inside_open' q c1'.
+      by apply: helper3;
+           rewrite !(mem_cat, inE, mem_rcons) ?c1'in ?c2in ?c1no' ?orbT.
+    by apply/esym/inside_open'_set_pts/esym.
+  rewrite inE=> /orP[/eqP -> | ].
+    move: helper2=> [-> | ->].
+      by apply: helper3; rewrite !(mem_cat, mem_rcons, inE) ?eqxx ?c2in ?orbT.
+    set W := (set_left_pts _ _).    
+    move=> q.
+    suff -> : inside_open' q W = inside_open' q lsto.
+      by apply: disjoint_open_closed;
+       rewrite ?mem_rcons ?mem_cat /= ?inE ?eqxx ?c2in ?orbT.
+    apply/esym/inside_open'_set_pts.
+    have := size_left_lsto pxhere palstol (underW puh).
+    by case : (left_pts lsto) => [ | p1 [ | p2 lpts]].
+  move=> c1f.
+  by apply: disjoint_open_closed;
+       rewrite ?mem_cat ?mem_rcons ?inE ?c1f ?c2in ?orbT.
+rewrite /generic_trajectories.update_open_cell_top.
+move : ebelow eonlsthe; rewrite lstheq=> /negbFE ebelow /negP/negP eonlsthe.
+have ponlsthe : point e === lsthe.
+  by rewrite lstheq; apply: under_above_on.
+have exi2 : exists2 c, c \in (lsto :: lop) &
+          contains_point' (point e) c.
+  exists lsto; first by rewrite inE eqxx.
+  by rewrite /contains_point' palstol /point_under_edge ebelow.
+case ogq : (outgoing e) => [ | fog og]; last first.
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+  rewrite oe=> oe'.
+  have lelow : le = low lsto.
+    move: oe; rewrite /open_cells_decomposition/generic_trajectories.open_cells_decomposition /=.
+    rewrite -/(contains_point _ _).
+    have -> : contains_point (point e) lsto.
+      by rewrite contains_pointE /point_under_edge ebelow underWC.
+    rewrite -/(open_cells_decomposition_contact _ _).
+    case : (open_cells_decomposition_contact _ _) => [[[a b] c] |] /=;
+      by move=> [] _ _ _ _ ->.
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi2.
+  have [pal puh vle vhe _]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+    have ognn : outgoing e != nil by rewrite ogq.
+    have:= opening_cells_aux_absurd_case vlo vhe ognn oute.
+    by rewrite ogq oca_eq /=.
+  rewrite /state_open_seq /state_closed_seq /=.
+  have := step_keeps_disjoint_default'; rewrite oe' ogq lelow oca_eq /=.
+  move=> [] clsdisj ocdisj.
+  split.           
+    move=> x y xin yin; apply: clsdisj.
+      move: xin; rewrite !(mem_rcons, inE, mem_cat).
+      move=>/orP[-> | /orP[ | /orP[ ->| ->]]]; rewrite ?orbT //.
+      by case: (cc) => /= [// | ? ?]; rewrite !inE /= => ->; rewrite ?orbT.
+    move: yin; rewrite !(mem_rcons, inE, mem_cat).
+    move=>/orP[-> | /orP[ | /orP[ ->| ->]]]; rewrite ?orbT //.
+    by case: (cc) => /= [// | ? ?]; rewrite !inE /= => ->; rewrite ?orbT.
+  move=> x y.
+  rewrite !mem_cat !inE -!orbA !(orbCA _ (_ == set_left_pts _ _)).
+  move=>/orP[]; last first.
+    move=> xin yin; apply: ocdisj.
+      rewrite !(mem_cat, inE).
+      by move: xin=> /orP[-> | /orP[-> | ->]]; rewrite ?orbT //.
+    move: yin; rewrite !(mem_rcons, mem_cat, inE).
+    move=>/orP[-> | /orP[ | /orP[-> | ->] ]]; rewrite ?orbT //.
+    by case: (cc) => /= [// | ? ?]; rewrite !inE /= => ->; rewrite ?orbT.
+  move=> /eqP -> yin.
+  apply: oc_disjoint_set_left_pts; last first.
+    apply: ocdisj;[subset_tac | ].
+    move: yin; rewrite !(mem_cat, inE, mem_rcons).
+    move=> /orP[-> | /orP[ | /orP[-> | ->]]]; rewrite ?orbT //.
+    by case: (cc) => /= [// | ? ?]; rewrite !inE /= => ->; rewrite ?orbT.
+  have ognn : outgoing e != nil by rewrite ogq.
+  have slsto := size_left_lsto pxhere palstol ebelow.
+  have:= opening_cells_first_left_pts he vlo ognn palstol.
+  rewrite ogq oca_eq /= => -> /=.
+  move: slsto; case lptsq : (left_pts lsto) => [// | fp [// | sp lpts]] _ /=.
+  have : open_cell_side_limit_ok lsto.
+    by apply: (allP open_side_limit); rewrite /open mem_cat inE eqxx orbT.
+  move=> /andP[] _ /andP[] A /andP[] _ /andP[] _ onlow.
+  rewrite pxhere lstxq /left_limit lptsq /=.
+  apply/(@eqP [eqType of pt]); rewrite pt_eqE /= eqxx /= eq_sym; apply/eqP.
+  have -> : pvert_y (point e) (low lsto) = pvert_y (last sp lpts) (low lsto).
+    apply: same_pvert_y=> //.
+    by rewrite pxhere lstxq /left_limit lptsq.
+  by apply: on_pvert; move: onlow; rewrite lptsq.
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite oe /= => oe'.
+rewrite /state_closed_seq /state_open_seq /=.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+  decomposition_main_properties oe' exi.
+have [pal puh vle vhe _]:=
+ decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+set nlsto := (X in (_ ++ X :: lc)).
+have lelow : le = low lsto.
+  move: oe; rewrite /open_cells_decomposition/generic_trajectories.open_cells_decomposition /=.
+  rewrite -/(contains_point _ _).
+  have -> : contains_point (point e) lsto.
+    by rewrite contains_pointE /point_under_edge ebelow underWC.
+  rewrite -/(open_cells_decomposition_contact _ _).
+  case : (open_cells_decomposition_contact _ _) => [[[a b] c] |] /=;
+    by move=> [] _ _ _ _ ->.
+have := step_keeps_disjoint_default'; rewrite oe' ogq lelow /=.
+rewrite -/(vertical_intersection_point _ _).
+rewrite pvertE // -/(vertical_intersection_point _ _) pvertE //=.
+have: Bpt (p_x (point e)) (pvert_y (point e) he) == point e :>pt = false.
+  apply/negP=> abs.
+  move: puh; rewrite strict_under_pvert_y // -[X in p_y X](eqP abs) /=.
+  by rewrite lt_irreflexive.
+have: point e == Bpt (p_x (point e)) (pvert_y (point e) (low lsto)) :> pt
+   = false.
+  apply/negP=> abs.
+  move: pal; rewrite under_pvert_y // lelow [X in p_y X](eqP abs) /=.
+  by rewrite le_eqVlt eqxx.
+do 2 rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+move=> -> -> [] clcnd clopcnd.
+split.
+  move=> x y xin yin; apply: clcnd.
+    move: xin; rewrite !(mem_rcons, mem_cat, inE) orbCA=> /orP[]; last first.
+      by move=> /orP[->| /orP[] ->]; rewrite ?orbT.
+    by case: (cc) => //= a l; rewrite inE=> ->; rewrite ?orbT.
+  move: yin; rewrite !(mem_rcons, mem_cat, inE) orbCA=> /orP[]; last first.
+    by move=> /orP[->| /orP[] ->]; rewrite ?orbT.
+  by case: (cc) => //= a l; rewrite inE=> ->; rewrite ?orbT.
+rewrite cats0.
+move=> x y xin yin.
+have yin' : y \in cls ++ lstc :: rcons (closing_cells (point e) cc)
+                            (close_cell (point e) lcc).
+  move: yin; rewrite !(mem_rcons, mem_cat, inE) orbCA=> /orP[]; last first.
+    by move=> /orP[-> | /orP[] ->]; rewrite ?orbT.
+  by case: (cc) => //= ? ?; rewrite inE=> ->; rewrite ?orbT.
+move: xin; rewrite !(mem_cat, mem_rcons, inE)=> /orP[xin | ].
+  apply: clopcnd; first by rewrite !(mem_cat, mem_rcons, inE) xin.
+  by rewrite cat_rcons.  
+move=>/orP[/eqP -> | xin]; last first.
+  apply: clopcnd.
+    by rewrite !(mem_cat, mem_rcons, inE) xin !orbT.
+  by rewrite cat_rcons.
+move=> q.
+move: clopcnd; set w := (X in _ ++ X :: _).
+have nlstoq : nlsto = set_pts w                      
+   (Bpt (p_x (point e)) (pvert_y (point e) he) :: left_pts lsto)
+   (right_pts lsto).
+   by rewrite /nlsto /generic_trajectories.pvert_y subrr.
+move=> clopcnd.
+rewrite nlstoq -inside_open'_set_pts.
+  apply: clopcnd.
+    by rewrite !(mem_cat, mem_rcons, inE) eqxx ?orbT.
+  by rewrite cat_rcons.
+rewrite /w /=.
+have /andP[] := allP open_side_limit lsto lstoin.
+case plstq : (left_pts lsto) => [ // | a l] _ /= /andP[] A /andP[] _ /andP[] _.
+move: lstxq; rewrite /left_limit plstq /= => sx one.
+apply/(@eqP [eqType of pt]); rewrite pt_eqE /= pxhere sx eqxx /=.
+rewrite -(on_pvert one).
+apply/eqP; apply: same_pvert_y; first by case/andP: one.
+by rewrite pxhere sx.
+Qed.
+
+Lemma step_keeps_injective_high_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) :=
+      opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+    {in fc ++ nos ++ lno :: lc &, injective high}.
+Proof.
+  case oe : open_cells_decomposition => [[[[[fc cc] lcc] lc] le] he].
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct
+     [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe ncont]
+ := connect_properties cbtom adj rfo sval bet_e ocd all_nct all_ct
+  lcc_ctn flcnct.
+have dupcase c1 c2 : (c1 \in fc) || (c1 \in lc) ->
+   c2 \in opening_cells (point e) (outgoing e) le he ->
+   high c1 = high c2 -> c1 = c2.
+  move=> c1in; rewrite leq heq => c2in hc1c2.
+  have v1 : valid_edge (high c1) (point e).
+    move: sval=>/allP/(_ c1); rewrite ocd -cat_rcons !mem_cat orbCA c1in orbT.
+    by move=> /(_ isT) /andP[].
+  have v2 : valid_edge (high c2) (point e).
+    have /andP[ _ ] := opening_cells_subset vle vhe oute c2in.
+    rewrite inE=> /orP[/eqP -> // | ].
+    by have := opening_valid oute vle vhe => /allP /(_ _ c2in) /andP[].
+  have : point e <<< high c1 \/ point e >>> high c1.
+    move: c1in=> /orP[] c1in.
+      right.
+      by have := decomposition_above_high_fc oe cbtom adj bet_e rfo sval c1in.
+    left.
+    have [s1 [s2 lcq]] := mem_seq_split c1in.
+    case s2q : s2 => [ | c1' s2'].
+      move: inbox_e=> /andP[] /andP[] _ + _.
+      suff -> : high c1 = top by [].
+      move: cbtom=> /andP[] _ /eqP; rewrite ocd lcq s2q /=.
+      by rewrite !(last_cat, last_cons) /=.
+    have c1'in : c1' \in lc by rewrite lcq s2q mem_cat !inE eqxx !orbT.
+    have := decomposition_under_low_lc oe cbtom adj bet_e rfo sval c1'in.
+    suff -> : high c1 = low c1' by [].
+    move: adj; rewrite /adjacent_cells ocd=> /sorted_catW /andP[] _.
+    move=> /sorted_catW /andP[] _; rewrite lcq s2q.
+    by rewrite /= -cat_rcons cat_path last_rcons /= => /andP[] _ /andP[] /eqP.
+  have /andP[lows ] := opening_cells_subset vle vhe oute c2in.
+  rewrite inE => /orP[/eqP hc1he | ]; last first.
+    rewrite hc1c2 => /oute/eqP <-.
+    move=> [ | ].
+      rewrite strict_nonAunder; last first.
+        by apply valid_edge_extremities; rewrite eqxx ?orbT.
+      by rewrite left_on_edge.
+    rewrite under_onVstrict ?left_on_edge //.
+    by apply valid_edge_extremities; rewrite eqxx ?orbT.
+  have c1hec : c1 = lcc.
+    apply: high_inj.
+        by rewrite ocd -cat_rcons!mem_cat orbCA c1in orbT.
+      by rewrite ocd !(mem_cat, inE) eqxx !orbT.
+    by rewrite hc1c2.
+  have := ncont _ c1in.
+  by rewrite c1hec lcc_ctn.
+have henout : he \notin outgoing e.
+  apply/negP=> /oute /eqP abs.
+  have :=
+    bottom_left_lex_to_high cbtom adj rfo open_side_limit inbox_e btm_left.
+  move=> /(_ lcc); rewrite ocd !(mem_cat, inE) eqxx !orbT => /(_ isT).
+  by rewrite -heq abs lexPt_irrefl.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+move=> c1 c2; rewrite -cat_rcons !mem_cat orbCA=> /orP[] c1in; last first.
+  rewrite orbCA=> /orP[] c2in; last first.
+    by apply: high_inj;
+      rewrite ocd -cat_rcons !mem_cat orbCA ?c1in ?c2in ?orbT.
+  by apply: (dupcase _ c2 c1in); rewrite /opening_cells oca_eq.
+rewrite orbCA=> /orP[] c2in; last first.
+  move/esym=> tmp; apply/esym; move: tmp.
+  by apply: (dupcase _ c1 c2in); rewrite /opening_cells oca_eq.
+have : uniq (rcons (sort (@edge_below _) (outgoing e)) he).
+  by rewrite rcons_uniq mem_sort henout sort_uniq.
+rewrite heq -(opening_cells_high vle vhe oute) => /uniq_map_injective; apply.
+all: rewrite /opening_cells -heq -leq oca_eq; by [].
+Qed.
+
+(* TODO : propose for inclusion in math-comp *)
+Lemma uniq_index (T : eqType) (x : T) l1 l2 :
+   uniq (l1 ++ x :: l2) -> index x (l1 ++ x :: l2) = size l1.
+Proof.
+elim: l1 => [/= | a l1 Ih]; first by rewrite eqxx.
+rewrite /= => /andP[].
+case: ifP => [/eqP -> | _ _ /Ih -> //].
+by rewrite mem_cat inE eqxx orbT.
+Qed.
+  
+Lemma index_map_in (T1 T2 : eqType) (f : T1 -> T2) (s : seq T1) :
+  {in s &, injective f} ->
+  {in s, forall x, index (f x) [seq f i | i <- s] = index x s}.
+Proof.
+elim: s => [ // | a s Ih] inj x xin /=.
+case: ifP => [/eqP/inj| fanfx].
+  rewrite inE eqxx; move=> /(_ isT xin) => ->.
+  by rewrite eqxx.
+case: ifP=> [/eqP ax | xna ]; first by rewrite ax eqxx in fanfx.
+congr (_.+1).
+apply: Ih=> //.
+  by move=> x1 x2 x1in x2in; apply: inj; rewrite !inE ?x1in ?x2in ?orbT.
+by move: xin; rewrite inE eq_sym xna.
+Qed.
+
+Lemma update_cells_injective_high l1 l2 l2' l3:
+  uniq (l1 ++ l2 ++ l3) ->
+  [seq high c | c <- l2] = [seq high c | c <- l2'] ->
+  {in l1 ++ l2 ++ l3 &, injective high} ->
+  {in l1 ++ l2' ++ l3 &, injective high}.
+Proof.
+move=> u2 eqh inj0 x1 x2; rewrite !mem_cat orbCA=> x1in.
+rewrite orbCA=> x2in hx1x2.
+move: x1in=> /orP[x1l2' | x1in]; last first.
+  move: x2in=> /orP[x2l2' | x2in]; last first.
+    by move: hx1x2; apply: inj0; rewrite !mem_cat orbCA ?x1in ?x2in ?orbT.
+  move: u2; rewrite uniq_catCA cat_uniq=> /andP[] _ /andP[] /negP abs _.
+  have : high x2 \in [seq high c | c <- l2].
+    by rewrite eqh; apply: map_f.
+  move=> /mapP[x20 x20in hx20].
+  rewrite -hx1x2 in hx20.
+  have x1x20: x1 = x20.
+    by apply: inj0; rewrite // ?mem_cat orbCA ?x20in ?x1in ?orbT.
+  case: abs; apply/hasP; exists x20=> //.
+  by rewrite -x1x20 mem_cat.
+move: x2in=> /orP[x2l2'| x2in]; last first.
+  move: u2; rewrite uniq_catCA cat_uniq=> /andP[] _ /andP[] /negP abs _.
+  have : high x1 \in [seq high c | c <- l2].
+    by rewrite eqh; apply: map_f.
+  move=> /mapP[x10 x10in hx10].
+  rewrite hx1x2 in hx10.
+  have x2x10: x2 = x10.
+    by apply: inj0; rewrite // !mem_cat orbCA ?x10in ?x2in ?orbT.
+  case: abs; apply/hasP; exists x10=> //.
+  by rewrite -x2x10 mem_cat.
+remember (index x1 l2') as j1 eqn:j1def.
+remember (index x2 l2') as j2 eqn:j2def.
+have inj2 : {in l2 &, injective high}.
+  by move=> u1 {}u2 uin1 uin2; apply: inj0; rewrite !mem_cat ?uin1 ?uin2 orbT.
+have ul2 : uniq l2.
+  by move: u2; rewrite !cat_uniq=> /andP[] _ /andP[] _ /andP[].
+have uh : uniq [seq high c | c <- l2].
+  by rewrite (map_inj_in_uniq inj2).
+have := nth_index dummy_cell x1l2'; rewrite -j1def => j1q.
+have := nth_index dummy_cell x2l2'; rewrite -j2def => j2q.
+have j1lt : (j1 < size l2')%N by rewrite j1def index_mem.
+have j2lt : (j2 < size l2')%N by rewrite j2def index_mem.
+have : nth (high dummy_cell) [seq high c | c <- l2'] j1 = high x1.
+  by rewrite (nth_map dummy_cell) // j1q.
+have : nth (high dummy_cell) [seq high c | c <- l2'] j2 = high x1.
+  by rewrite hx1x2 (nth_map dummy_cell) // j2q.
+move=> <-; rewrite -eqh. 
+move: uh=> /uniqP => /(_ dummy_edge); rewrite [X in size X]eqh size_map.
+move=> /(_ j1 j2); rewrite !inE => /(_ j1lt j2lt) /[apply].
+by rewrite -j1q -j2q => ->.
+Qed.
+
+Lemma step_keeps_uniq_default fc cc lcc lc le he nos lno:
+  open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
+  opening_cells_aux (point e) 
+      (sort (@edge_below _) (outgoing e)) le he = (nos, lno) ->
+  uniq (fc ++ nos ++ lno :: lc).
+Proof.
+move=> oe oca_eq.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe old_nctn]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+have := opening_cells_contains_point vle vhe pal puh oute.
+rewrite /opening_cells oca_eq => /(_ _ erefl)=> new_ctn.
+have uo : uniq (sort (@edge_below _) (outgoing e)) by rewrite sort_uniq.
+have heno : he \notin (sort (@edge_below _) (outgoing e)).
+  apply/negP=> /oute'/eqP; move: puh=> /[swap] <-.
+  by rewrite (negbTE (left_pt_above he)).
+have uniqnew := opening_cells_aux_uniq uo heno oute' vle vhe oca_eq.
+rewrite -cat_rcons uniq_catCA cat_uniq uniqnew.
+move: uniq_open; rewrite ocd -cat_rcons uniq_catCA cat_uniq=> /andP[] _.
+move=>/andP[] _ ->; rewrite andbT /= -all_predC /=.
+apply/allP=> x /=; rewrite mem_cat=> /old_nctn nctn.
+by apply/negP=> /new_ctn/nctn.
+Qed.
+
+Lemma step_keeps_injective_high :
+  let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {in state_open_seq s' &, injective high}.
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP=> [pxaway |/negbFE/eqP /[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition open (point e)) =>
+     [[[[[fc  cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  rewrite /state_closed_seq /state_open_seq /=.
+  have := step_keeps_injective_high_default; rewrite oe oca_eq /=.
+  by rewrite catA.
+case: ifP=> [eabove | ebelow].
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  have oe' :
+    open_cells_decomposition open (point e) =
+     (rcons fop lsto ++ fc', cc, lcc, lc, le, he).
+    move: adj rfo sval; rewrite /open -cat_rcons=> adj' rfo' sval'.
+    move: (open_cells_decomposition_cat adj' rfo' sval' (exi' eabove)).
+    by rewrite oe; apply.
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe' exi.
+  have [pal puh vle vhe _]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe'.
+  rewrite /state_open_seq.
+  rewrite appE.
+  rewrite -(cat_rcons lsto) -catA -(cat_rcons lno).
+  have := step_keeps_injective_high_default.
+  by rewrite oe' oca_eq /= !catA -cat_rcons.
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  have oe : open_cells_decomposition open (point e) =
+          (fop, [::], lsto, lop, low lsto, high lsto).
+    by rewrite open_cells_decomposition_single=> //; rewrite -lstheq.
+  have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+  rewrite /state_open_seq /=.
+  rewrite -/(update_open_cell _ _).
+  case uoc_eq : (update_open_cell _ _) => [nos lno] /=.
+  rewrite -catA -cat_rcons.
+  move: uoc_eq; rewrite /update_open_cell/generic_trajectories.update_open_cell.
+  case ogq : (outgoing e) => [ | fog ogs].
+    move=> [] <- <-; rewrite [rcons _ _]/=.
+    have uniqlsto : uniq (fop ++ [:: lsto] ++ lop).
+      by move: uniq_open; rewrite /open.
+    set w := (X in fop ++ X ++ lop).
+    have samehigh: [seq high c | c <- [:: lsto]] = [seq high c | c <- w] by [].
+    by apply: (update_cells_injective_high uniqlsto samehigh).
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos'] lno'].
+    have ogn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vho ogn oute.
+    by rewrite ogq oca_eq.
+  move=> [] <- <-.
+  have := step_keeps_injective_high_default.
+  rewrite oe ogq oca_eq -cat_rcons.
+  apply: update_cells_injective_high.
+    have := step_keeps_uniq_default oe; rewrite ogq=> /(_ _ _ oca_eq).
+    by rewrite cat_rcons catA.
+  by rewrite !map_rcons.
+case oe': open_cells_decomposition => [[[[[fc' cc'] lcc'] lc'] le'] he'].
+have lsto_ctn : contains_point' (point e) lsto.
+  rewrite /contains_point' palstol -lstheq.
+  by move: ebelow=> /negbT; rewrite negbK.
+have exi2 : exists2 c, c \in lsto :: lop & contains_point' (point e) c.
+  by exists lsto; [rewrite inE eqxx | ].
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe' exi2.
+rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+rewrite -/(open_cells_decomposition _ _) oe'.
+case ogq : (outgoing e) => [ | fog ogs] /=.
+  rewrite /state_open_seq /= cats0 -cat1s.
+  have : {in fop ++ fc' ++ [:: lcc'] ++ lc' &, injective high}.
+    have subtmp : {subset fop ++ fc' ++ lcc' :: lc' <= open}.
+      move=> x; rewrite /open ocd !(mem_cat, inE).
+      repeat (move=> /orP[ -> | ]; rewrite ?orbT //).
+      by move=> ->; rewrite ?orbT.
+    by move=> x y xin yin; apply: high_inj; apply: subtmp.
+  rewrite catA.
+  apply: update_cells_injective_high.
+    rewrite cat_uniq; move: uniq_open; rewrite /open ocd catA.
+    rewrite [X in is_true X -> _]cat_uniq=> /andP[] -> /= /andP[].
+    rewrite has_cat negb_or => /andP[] _ /= => ->.
+    by rewrite [X in is_true X -> _]cat_uniq => /andP[] _ /andP[] _.
+  by rewrite /= heq.
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite oe' => oe.
+have [pal puh vle vhe _]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [ [ | fno nos] lno].
+  have ogn : fog :: ogs != nil by [].
+  have := opening_cells_aux_absurd_case vlo vhe ogn.
+  by rewrite -[X in {in X, _}]ogq oca_eq => /(_ oute).
+rewrite /state_open_seq /= !catA -(catA (_ ++ _)) -cat_rcons.
+have := step_keeps_injective_high_default.
+rewrite oe ogq.
+have le'q : le' = low lsto.
+  have := last_step_situation oe' pxhere.
+  rewrite -/(point_strictly_under_edge _ _) in eonlsthe.
+  rewrite eonlsthe=> /(_ isT).
+  move: ebelow=> /negbT.
+  rewrite -/(point_under_edge _ _).
+  by rewrite negbK=> -> /(_ isT)[] + [].
+rewrite le'q oca_eq -cat_rcons.
+apply: update_cells_injective_high=> //.
+have := step_keeps_uniq_default oe; rewrite ogq le'q=> /(_ _ _ oca_eq).
+by rewrite cat_rcons !catA.
+Qed.
+
+(* TODO : understand why closing_cells_to_the_left seems to use too many
+   hypotheses, once out of the section. *)
+Lemma closing_cells_to_the_left fc cc lcc lc le he :
+  open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
+  {in closing_cells (point e) cc, forall c, right_limit c <= p_x (point e)} /\
+  right_limit (close_cell (point e) lcc) <= p_x (point e).
+Proof.
+move=> oe.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe _]:=
+  decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+split; last first.
+  have vlolcc : valid_edge (low lcc) (point e).
+    apply: (proj1 (andP (allP sval lcc _))).
+    by rewrite ocd !(mem_cat, inE) eqxx ?orbT.
+  rewrite /close_cell (pvertE vlolcc).
+  rewrite -heq (pvertE vhe) /right_limit /=.
+  by case: ifP; case: ifP.
+move=> c /mapP[c' c'in ->].
+have c'in2 : c' \in open by rewrite ocd !mem_cat c'in ?orbT.
+have /andP[vlc vhc] := allP sval c' c'in2.
+rewrite /close_cell (pvertE vlc) (pvertE vhc) /=.
+by case: ifP; case: ifP.
+Qed.
+
+Lemma update_closed_cell_keeps_right_limit c pt :
+  closed_cell_side_limit_ok c ->
+  right_limit (update_closed_cell c pt) =
+  right_limit c.
+Proof.
+do 5 move=> /andP[_]; move=> /andP[ptsn0 /andP[/allP allx _]].
+rewrite /update_closed_cell /right_limit /=.
+elim/last_ind: {-1} (right_pts c) (erefl (right_pts c))
+     ptsn0=> [ // | [ // | pt0 pts] ptf _] ptsq _ /=.
+  by rewrite last_cat.
+Qed.
+
+Lemma step_keeps_closed_to_the_left :
+  let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {in state_closed_seq s', forall c, right_limit c <= p_x (point e)}.
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP => [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  rewrite /state_closed_seq /=.
+  have [ccP lccP] := closing_cells_to_the_left oe.
+  move=> x; rewrite mem_rcons inE => /orP[/eqP -> // | ].
+  by rewrite appE -cat_rcons mem_cat => /orP[/closed_right_limit | /ccP].
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  move: adj rfo sval; rewrite /open -cat_rcons => adj' rfo' sval'.
+  have := open_cells_decomposition_cat adj' rfo' sval' (exi' eabove) eabove'.
+  rewrite oe' cat_rcons => oe.
+  have [ccP lccP] := closing_cells_to_the_left oe.
+  rewrite /state_closed_seq /=.
+  move=> x; rewrite mem_rcons inE => /orP[/eqP -> // | ].
+  by rewrite appE -cat_rcons mem_cat => /orP[ /closed_right_limit | /ccP].
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite -/(update_open_cell _ _).
+  case uoc_eq : (update_open_cell _ _) => [nos lno].
+  rewrite /state_closed_seq /=.
+  move=> x; rewrite mem_rcons inE => /orP[/eqP -> | ].
+    rewrite /update_closed_cell /right_limit /=.
+    have := non_empty_right; case pts_eq: (right_pts lstc) => [| p1 rpts] // _.
+    rewrite /= last_cat /=.
+    have /closed_right_limit: lstc \in rcons cls lstc.
+      by rewrite mem_rcons inE eqxx.
+    by rewrite /right_limit pts_eq.
+  move=> xin.
+  suff /closed_right_limit : x \in rcons cls lstc by [].
+  by rewrite mem_rcons inE xin orbT.
+rewrite -/(open_cells_decomposition _ _).
+case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+rewrite -/(update_open_cell_top lsto _ e).
+case uoct_eq : (update_open_cell_top lsto _ _) => [nos lno].
+have exi2 : exists2 c, c \in (lsto :: lop) &
+          contains_point' (point e) c.
+  exists lsto; first by rewrite inE eqxx.
+  by rewrite /contains_point' palstol -lstheq /point_under_edge (negbFE ebelow).
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite -/(open_cells_decomposition _ _).
+rewrite oe' => oe.
+rewrite /state_closed_seq /=.
+have [ccP lccP] := closing_cells_to_the_left oe.
+move=> x; rewrite mem_rcons inE => /orP[/eqP ->|]; first by [].
+rewrite mem_cat=> /orP[xin | ].
+  have /ccP // : x \in closing_cells (point e) cc.
+  by move/mapP: xin=> [] x' x'in ->; apply/map_f/mem_behead.
+by rewrite -mem_rcons; apply: closed_right_limit.
+Qed.
+
+Lemma contains_right (c : cell) :
+  c \in open ->  right_pt (high c) = point e -> contains_point (point e) c.
+Proof.
+move=> cino rq.
+have /andP[vlc vhc] := allP sval c cino.
+apply/andP; split; last first.
+ rewrite -/(point_under_edge _ _).
+  by rewrite under_onVstrict // -rq right_on_edge.
+apply/negP=> abs.
+have bl := allP rfo c cino.
+have := order_edges_strict_viz_point vlc vhc bl abs.
+by rewrite (strict_nonAunder vhc) -rq right_on_edge.
+Qed.
+
+Lemma inbox_lexePt_right_bt g pt:
+  inside_box pt ->
+  g \in [:: bottom; top] -> lexePt pt (right_pt g).
+Proof.
+rewrite !inE /inside_box /lexePt.
+by move=> /andP[] _ /andP[] /andP[] _ lb /andP[] _ lt /orP[] /eqP ->;
+  rewrite ?lt ?lb.
+Qed.
+
+Lemma inside_box_lexPt_bottom pt :
+  inside_box pt -> lexPt (left_pt bottom) pt && lexPt pt (right_pt bottom).
+Proof.
+by move=> /andP[] _ /andP[] /andP[] lp pr  _; rewrite /lexPt lp pr.
+Qed.
+
+Lemma inside_box_lexPt_top pt :
+  inside_box pt -> lexPt (left_pt top) pt && lexPt pt (right_pt top).
+Proof.
+by move=> /andP[] _ /andP[]  _ /andP[] lp pr; rewrite /lexPt lp pr.
+Qed.
+
+Lemma step_keeps_lex_edge_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+   forall e', inside_box (point e') -> lexPtEv e e' ->
+               (forall e2, e2 \in future_events -> lexePtEv e' e2) ->
+   {in [seq high c | c <- fc ++ nos ++ lno :: lc], forall g,
+       lexPt (left_pt g) (point e') && lexePt (point e') (right_pt g)}.
+Proof.
+case oe : (open_cells_decomposition _ _) =>
+ [[[[[fc cc] lcc] lc] le] he].
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos nlsto].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vl vp nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+move=> e' inbox_e' ee' e'fut g.
+rewrite !map_cat !mem_cat.
+have old:  (g \in [seq high c | c <- fc]) || (g \in [seq high c | c <- lc]) ->
+   lexPt (left_pt g) (point e') && lexePt (point e') (right_pt g).
+  move=> gin; apply/andP; split.
+    have /lexPt_trans : lexPt (left_pt g) (point e).
+      have /lex_open_edges /andP[] // : g \in [seq high c | c <- open].
+      rewrite ocd !map_cat !mem_cat map_cons inE.
+      by move: gin => /orP[ | ] ->; rewrite ?orbT.
+    by apply.
+  have /mapP [c cin gq] : g \in [seq high c | c <- fc ++ lc].
+    by rewrite map_cat mem_cat.
+  have cino : c \in open.
+    by move: cin; rewrite ocd !mem_cat /= inE=> /orP[] ->; rewrite ?orbT.
+  move : (allP clae _ cino)=> /andP[] _; rewrite /end_edge.
+  move=> /orP[ /(inbox_lexePt_right_bt inbox_e') | ]; first by rewrite gq.
+  rewrite -gq; move=> /hasP [e2 e2in /eqP /[dup] e2P ->].
+  apply: e'fut.
+  move: e2in; rewrite inE => /orP[/eqP e2e | ]; last by [].
+  move: (cin); rewrite mem_cat => /nc [].
+  by apply: contains_right; rewrite // -e2e -gq.
+move=> /orP[oldf |]; first by apply: old; rewrite oldf.
+rewrite /= inE orbA=> /orP[| oldl]; last by apply: old; rewrite oldl orbT.
+move=> /orP[go | ghe].
+  have := opening_cells_aux_high vl vp oute'; rewrite oca_eq /=.
+  move: go=> /[swap] -> /[dup] go /oute' /eqP /[dup] ge ->.
+  rewrite mem_sort in go.
+  apply/andP; split; first by exact ee'.
+  have := cle; rewrite /= /close_out_from_event /end_edge => /andP[] + _.
+  move=> /allP /(_ g go).
+  by move=> /hasP[e3 e3in /eqP ->]; apply: e'fut.
+have := opening_cells_aux_high_last vl vp oute'; rewrite oca_eq /= -(eqP ghe).
+move=> {}ghe.
+have lcco : lcc \in open by rewrite ocd !mem_cat inE eqxx !orbT.
+have /lex_open_edges : g \in [seq high c | c <- open].
+  by apply/mapP; exists lcc; rewrite // ghe.
+move=> /andP[] left_e e_right.
+rewrite (lexPt_trans left_e ee') /=.
+have := (allP clae lcc lcco) => /andP[] _; rewrite /end_edge.
+move=> /orP[].
+  rewrite !inE -heq -ghe => /orP[] /eqP ->; move: inbox_e'.
+    by move=> /inside_box_lexPt_bottom /andP[] _ /lexPtW.
+  by move=> /inside_box_lexPt_top /andP[] _ /lexPtW.
+move=> /hasP [e2 + /eqP ge2].
+rewrite inE=> /orP[ /eqP abs | ].
+  suff /onAbove : point e === he by rewrite puh.
+  by rewrite -abs -ge2 heq right_on_edge.
+by move=> /e'fut; rewrite /lexePtEv -ge2 -heq ghe.
+Qed.
+
+Lemma step_keeps_lex_edge :
+  let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  forall e', inside_box (point e') -> lexPtEv e e' ->
+               (forall e2, e2 \in future_events -> lexePtEv e' e2) ->
+   {in [seq high c | c <- state_open_seq s'], forall g,
+       lexPt (left_pt g) (point e') && lexePt (point e') (right_pt g)}.
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP => [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  rewrite /state_open_seq /state_closed_seq /=.
+  move=> e' in_e' ee' e'fut.
+  by have := step_keeps_lex_edge_default; rewrite oe oca_eq catA; apply.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  move: adj rfo sval; rewrite /open -cat_rcons => adj' rfo' sval'.
+  have := open_cells_decomposition_cat adj' rfo' sval' (exi' eabove) eabove'.
+  rewrite oe' cat_rcons => oe.
+  rewrite /state_open_seq /state_closed_seq /=.
+  have := step_keeps_lex_edge_default; rewrite oe oca_eq.
+  move=> main e' in_e' ee' e'fut g /mapP[c cin gq].
+  apply: (main e' in_e' ee' e'fut); apply/mapP; exists c; last by [].
+  by move: cin; rewrite !(mem_rcons, mem_cat, inE) !orbA (orbC _ (c == lsto)).
+have ebelow' : point e <<= lsthe by exact (negbFE ebelow).
+case: ifP => [ebelow_st | enolsthe].
+  rewrite /state_open_seq /update_open_cell/generic_trajectories.update_open_cell /=.
+  have belowo : point e <<< high lsto by rewrite -lstheq.
+  have := open_cells_decomposition_single adj rfo sval palstol belowo.
+  move=> oe.
+  have [ocd [lcc_ctn [_ [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+  have [pal puh vl vp nc]:=
+   decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+  case ogq: (outgoing e) => [ | fog ogs] /=.
+    move=> e' in_e' ee' e'fut; rewrite cats0=> g /mapP [c + gq].
+    rewrite mem_cat inE orbCA gq=> /orP[/eqP /[dup] cq -> /= | ].
+      rewrite (fun h => lexPt_trans h ee')/=; last first.
+        apply: (proj1 (andP (lex_open_edges (map_f _ _)))).
+        by rewrite mem_cat inE eqxx orbT.
+      have /andP[_ /orP[|] ] := (allP clae lsto lstoin).
+        by move=>/(inbox_lexePt_right_bt in_e').
+      move=> /hasP [e2].
+      rewrite inE => /orP[/eqP -> | /e'fut +] /eqP rq.
+        move: (strict_nonAunder vho); rewrite -lstheq /point_strictly_under_edge ebelow_st=>/esym.
+        move: gq; rewrite cq high_set_left_pts=> gq.
+        by rewrite lstheq -rq right_on_edge.
+      by rewrite /lexePtEv -rq.
+    move=> cold; apply/andP.
+    have cino : c \in open.
+      by rewrite mem_cat inE; move: cold=> /orP[] ->; rewrite ?orbT .
+    split.
+      apply: lexPt_trans ee'.
+      by have /andP[] := lex_open_edges (map_f _ cino).
+    have /andP[_] := (allP clae _ cino).
+    move=> /orP[].
+      by move=> /(inbox_lexePt_right_bt in_e').
+    move=> /hasP[e2 + /eqP e2P]; rewrite inE => /orP[/eqP e2e | ].
+      rewrite e2e in e2P.
+      by move: (nc _ cold)=> []; apply: contains_right.
+    by move=> /e'fut; rewrite /lexePtEv -e2P.
+  rewrite -ogq.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno].
+    have ogn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vho ogn oute.
+    by rewrite oca_eq.
+  rewrite /= => e' in_e' ee' e'fut g /mapP[c cin gq].
+  have := step_keeps_lex_edge_default.
+  rewrite oe oca_eq=> /(_ e' in_e' ee' e'fut) main.
+  move: cin; rewrite -!catA /= mem_cat => /orP[cin | ].
+    by apply: main; apply/mapP; exists c; rewrite // mem_cat cin.
+  rewrite inE=> /orP[/eqP cq | ].
+    rewrite gq cq high_set_left_pts; apply: main.
+    by apply/mapP; exists fno; rewrite // !(mem_cat, inE) eqxx ?orbT.
+  move=> cin; apply: main.
+  by apply/mapP; exists c; rewrite //= mem_cat inE cin !orbT.
+move=> e' in_e' ee' e'fut.
+rewrite -/(open_cells_decomposition _ _).
+case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+rewrite -/(update_open_cell_top _ _ _).
+case uoctq: update_open_cell_top => [nos lno].
+rewrite /state_open_seq /= -!catA.
+move=> g /mapP [c cin gq]; rewrite gq {gq}.
+have exi2 : exists2 c, c \in lsto :: lop & contains_point' (point e) c.
+  exists lsto; first by rewrite inE eqxx.
+  by rewrite /contains_point' palstol -lstheq ebelow'.
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite oe'=> oe.
+have [ocd [lcc_ctn [_ [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vl vp nc]:=
+   decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+have := step_keeps_lex_edge_default; rewrite oe => main.
+move: uoctq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+have := last_step_situation oe' pxhere (negbT enolsthe) ebelow'.
+move=> [] fc'0 [] leo [cc' ccq].
+case ogq : (outgoing e) => [ | fog ogs]; last first.
+  rewrite -ogq.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [ [ | fno nos'] lno'].
+    have ogn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vp ogn oute.
+    by rewrite oca_eq.
+  move=> -[] nosq lnoq.
+  move: main; rewrite leo oca_eq => /(_ _ in_e' ee' e'fut) main.
+  move: cin; rewrite mem_cat=> /orP[cin | ].
+    by apply: main; apply/mapP; exists c; rewrite // !mem_cat cin.
+  rewrite fc'0 /= mem_cat inE orbA=> /orP[|cin]; last first.
+    by apply: main; apply/mapP; exists c; rewrite // !(mem_cat, inE) cin !orbT.
+  move=> /orP[ | /eqP clno]; last first.
+    apply: main; apply/mapP; exists c; rewrite // lnoq !(mem_cat, inE) clno.
+    by rewrite eqxx !orbT.
+  rewrite -nosq inE=> /orP[ | cin]; last first.
+    by apply: main; apply/mapP; exists c; rewrite // !(mem_cat, inE) cin !orbT.
+  move=> /eqP ->; rewrite high_set_left_pts.
+  by apply: main; apply/mapP; exists fno; rewrite // !mem_cat inE eqxx !orbT.
+move=> [] nosq lnoq.
+have oca_eq : opening_cells_aux (point e) (sort (@edge_below _) (outgoing e))
+   le he =
+  ([::], (Bcell (@no_dup_seq [eqType of pt]
+      [:: (Bpt (p_x (point e)) (pvert_y (point e) he));
+          (point e);
+          (Bpt (p_x (point e)) (pvert_y (point e) le))]) [::] le he)).
+  rewrite ogq -[sort _ _]/[::].
+  rewrite /opening_cells_aux/generic_trajectories.opening_cells_aux.
+  by rewrite -/(vertical_intersection_point _ _) (pvertE vl)
+       -/(vertical_intersection_point _ _)  (pvertE vp).
+move: main; rewrite oca_eq => /(_ _ in_e' ee' e'fut)=> main.
+move: cin; rewrite mem_cat=> /orP[cin |].
+  by apply: main; apply/mapP; exists c; rewrite // !mem_cat cin.
+rewrite fc'0 -nosq /= inE=> /orP[/eqP clno | cin]; last first.
+  by apply: main; apply/mapP; exists c; rewrite // !(mem_cat, inE) cin !orbT.
+apply: main.
+rewrite map_cat /=.
+suff ->: high c = he by rewrite !(mem_cat, inE) eqxx !orbT.
+by rewrite clno -lnoq /=.
+Qed.
+
+Lemma opening_cells_aux_cover_outgoing le he nos lno:
+  valid_edge le (point e) ->
+  opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he =
+  (nos, lno) ->
+  {in (outgoing e), forall g, 
+  exists c, c \in nos /\ high c = g /\ left_limit c = p_x (left_pt g)}.
+Proof.
+move=> + + g go.
+have go' : g \in sort (@edge_below _) (outgoing e) by rewrite mem_sort.
+elim: (sort _ _) go' oute' le nos lno {go} => [ // | g' og Ih].
+rewrite inE=> /orP[/eqP -> | gin]; move=> + le nos lno vle.
+  have /[swap] /[apply] /eqP lpg' : g' \in g' :: og by rewrite inE eqxx.
+  rewrite /=.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case: (opening_cells_aux _ _ _ _) => s nc.
+  rewrite -/(vertical_intersection_point _ _) (pvertE vle).
+  set it := Bcell _ _ _ _; move=> [] sq ncq; exists it.
+  rewrite -sq inE eqxx; split=> //; split=> //.
+  rewrite /left_limit /=.
+  rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+  by case: ifP => [/eqP -> /=| /= ]; rewrite lpg'.
+move=> outg'.
+have outg : {in og, forall g, left_pt g == point e}.
+  by move=> x xin; apply: outg'; rewrite inE xin orbT.
+rewrite /=.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [s nc].
+rewrite -/(vertical_intersection_point _ _) (pvertE vle) => - [sq ncq].
+have vg : valid_edge g' (point e).
+  rewrite -(eqP (outg' g' _)); last by rewrite inE eqxx.
+  by apply: valid_edge_left.
+have [it [P1 P2]]:= Ih gin outg g' s nc vg oca_eq.
+  exists it; split; last by [].
+by rewrite -sq inE P1 orbT.
+Qed.
+
+Lemma step_keeps_edge_covering_default gen_closed fc cc lcc lc le he nos lno:
+  open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
+  opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he =
+     (nos, lno) ->
+  forall g,
+  edge_covered g open gen_closed \/ g \in outgoing e ->
+  edge_covered g (fc ++ nos ++ lno :: lc)
+    (gen_closed ++ rcons (closing_cells (point e) cc)
+         (close_cell (point e) lcc)).
+Proof.
+move=> oe oca_eq.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe old_nctn]:=
+   decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+move=> g [go | gn]; last first.
+  have [c [cin [highc cleft]]]:=
+      opening_cells_aux_cover_outgoing vle oca_eq gn.
+  left; exists c, [::]; split=> /=; first by [].
+  split; first by move=> c'; rewrite inE=> /eqP ->.
+  split; first by [].
+  split; last by [].
+  by rewrite !mem_cat cin !orbT.
+case: go => [[opc [pcc [pccsub opcP]]] | 
+              [ pcc [pccn0 [pccsub pccP]]]]; last first.  
+  right; exists pcc.
+ split;[exact pccn0 | split; [ | exact pccP]].
+  by move=> g1 /pccsub; rewrite mem_cat=> ->.
+move: opcP => [highc [cnc [opco pccl]]].
+have [ghe | gnhe] := eqVneq g he.
+  have vllcc : valid_edge (low lcc) (point e).
+    apply: (seq_valid_low sval); rewrite ocd !map_cat !mem_cat /= inE.
+    by rewrite eqxx ?orbT.
+  have lccq : lcc = opc.
+    apply: high_inj=> //; first by rewrite ocd !(mem_cat, inE) eqxx !orbT.
+    by rewrite (highc opc) ?ghe; last rewrite mem_rcons inE eqxx.
+  left; exists lno, (rcons pcc (close_cell (point e) lcc)).
+  split.
+    move=> c; rewrite mem_rcons inE=> /orP[/eqP -> | /pccsub].
+      by rewrite !(mem_rcons, mem_cat, inE) eqxx ?orbT.
+    by rewrite mem_cat=> ->.
+  split.
+    move=> c; rewrite !(mem_rcons, inE).
+    move=> /orP[/eqP |/orP[/eqP | inpcc]]; last 1 first.
+        by apply: highc; rewrite !(mem_rcons, mem_cat, inE, inpcc, orbT).
+      rewrite /close_cell.
+      move=> ->; rewrite ghe.
+      have := higher_edge_new_cells oute vle vhe.
+      by rewrite /opening_cells oca_eq => /(_ _ erefl); rewrite last_rcons.
+    rewrite /close_cell=> ->.
+    by rewrite -heq (pvertE vhe) (pvertE vllcc) /= ghe.
+  split.
+    elim/last_ind : {-1} pcc (erefl pcc) => [pcceq | pcc1 lpcc _ pcceq].
+      rewrite /= andbT.
+      rewrite close_cell_right_limit; last first.
+        by rewrite /valid_cell vllcc -heq vhe.
+      have /(_ lno) -> // := opening_cells_left oute vle vhe.
+      by rewrite /opening_cells oca_eq mem_rcons inE eqxx.
+    rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
+    apply/andP; split; last first.
+      rewrite last_rcons right_limit_close_cell //.
+        have /(_ lno) -> // := opening_cells_left oute vle vhe.
+        by rewrite /opening_cells oca_eq mem_rcons inE eqxx.
+      by rewrite -heq.
+    rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
+    move: cnc.
+    rewrite pcceq connect_limits_rcons; last by apply/eqP/rcons_neq0.
+    move=> /andP[] -> /eqP ->.
+    by rewrite left_limit_close_cell lccq eqxx.
+  split; first by rewrite !(mem_cat, inE, eqxx, orbT).
+  move: pccl; rewrite lccq; case: (pcc)=> /=; last by [].
+  by rewrite left_limit_close_cell.
+rewrite -cat_rcons.
+move: opco; rewrite ocd -cat_rcons !mem_cat orbCA => /orP[]; last first.
+  move=> opc_pres.
+  left; exists opc, pcc.
+  split; first by apply: subset_catrl.
+  split; first by [].
+  split; first by [].
+  split; last by [].
+  by rewrite !mem_cat orbCA opc_pres orbT.
+move=> opcc.
+right.
+have [_ highopc leftopc] := close_cell_preserve_3sides (point e) opc.
+exists (rcons pcc (close_cell (point e) opc)).
+split.
+  by apply/eqP/rcons_neq0.
+split.
+  move=> c; rewrite mem_rcons inE=> /orP[/eqP -> | ].
+    rewrite mem_cat/closing_cells; apply/orP; right.
+    by rewrite -map_rcons; apply/mapP; exists opc.
+  by move=> /pccsub cin; rewrite mem_cat cin.
+split.
+  move=> c; rewrite mem_rcons inE => /orP[/eqP -> | inpcc]; last first.
+    by apply highc; rewrite mem_rcons inE inpcc orbT.
+  by rewrite highopc; apply highc; rewrite mem_rcons inE eqxx.
+split.
+  have [/eqP -> | pccn0] := boolP (pcc == [::]).
+    by [].
+  move: cnc; rewrite !connect_limits_rcons // => /andP[] -> /eqP -> /=.
+  by rewrite /left_limit leftopc.
+split.
+  move: pccl; case pccq: pcc => [ | pcc0 pcc'] //=.
+  by rewrite /left_limit leftopc.
+have opco : opc \in open.
+  by rewrite ocd -cat_rcons !mem_cat opcc orbT.
+rewrite /last_cell last_rcons right_limit_close_cell; last first.
+    by apply/(seq_valid_high sval)/map_f.
+  by apply/(seq_valid_low sval)/map_f.
+have hopc : high opc = g by apply: highc; rewrite mem_rcons inE eqxx.
+have {}opcc : opc \in cc.
+  move: opcc; rewrite mem_rcons inE=> /orP[] // /eqP abs.
+  by case/eqP: gnhe; rewrite -hopc abs.
+have e_on : point e === high opc.
+  by apply: (open_cells_decomposition_point_on cbtom adj bet_e sval oe opcc).
+have [ abs | -> ] := open_non_inner opco e_on; last by rewrite hopc.
+have := bottom_left_lex_to_high cbtom adj rfo open_side_limit.
+move=> /(_ _ inbox_e btm_left _ opco).
+by rewrite abs lexPt_irrefl.
+Qed.
+
+Lemma edge_covered_set_left_pts g l1 c l2 l3 lpts :
+  left_limit c = p_x (last dummy_pt lpts) ->
+  edge_covered g (l1 ++ c :: l2) l3 ->
+  edge_covered g (l1 ++ (set_left_pts c lpts) :: l2) l3.
+Proof.
+move=> left_cond [active | [pcc pccP]]; last by right; exists pcc; exact pccP.
+move: active => [opc [pcc [pccP1 [pccP2 [pccP3 [pccP4 pccP5]]]]]].
+have [copc | cnopc] := eqVneq c opc.
+  left; exists (set_left_pts c lpts), pcc.
+  split; first by [].
+  split.
+    move=> x; rewrite mem_rcons inE=> /orP[ /eqP -> | xin]; last first.
+      by apply: pccP2; rewrite mem_rcons inE xin orbT.
+    rewrite /set_left_pts /=.
+    by apply: pccP2; rewrite mem_rcons inE copc eqxx.
+  split.
+    have [-> | pccn0] := eqVneq pcc [::]; first by [].
+    move: pccP3; rewrite !connect_limits_rcons // => /andP[] -> /eqP -> /=.
+    rewrite /set_left_pts /=.
+    by rewrite -copc left_cond /left_limit.
+  split; first by rewrite mem_cat inE eqxx orbT.
+   move: pccP5; have [-> /= | pccn0] := eqVneq pcc [::].
+     by rewrite -copc left_cond.
+   by move: pccn0; case: (pcc).
+left; exists opc, pcc.
+split; first by [].
+split; first by [].
+split; first by [].
+split; last by [].
+move: pccP4.
+rewrite !mem_cat !inE=> /orP[ -> | /orP [ | -> ]]; rewrite ?orbT //.
+by move: cnopc=> /[swap]; rewrite eq_sym=> ->.
+Qed.
+
+Lemma update_closed_cell_keep_left_limit c pt : 
+  left_limit (update_closed_cell c pt) = left_limit c.
+Proof. by move: c => [? ? ? ?]. Qed.
+
+Lemma connect_limits_seq_subst (l : seq cell) c c' :
+  left_limit c = left_limit c' -> right_limit c = right_limit c' ->
+  connect_limits l -> connect_limits (seq_subst l c c').
+Proof.
+move=> ll rr; elim: l => [ | a [ | b l] Ih] /=; first by [].
+  by case: ifP.
+move=> /[dup] conn /andP[ab conn'].
+have conn0 : path (fun c1 c2 => right_limit c1 == left_limit c2) a (b :: l).
+   by exact: conn. 
+have /Ih : sorted (fun c1 c2 => right_limit c1 == left_limit c2) (b :: l).
+  by apply: (path_sorted conn0).
+case: ifP=> [/eqP ac | anc].
+  rewrite /=; case: ifP => [/eqP bc | bnc].
+    by rewrite /= -rr -ll -ac (eqP ab) ac -bc eqxx.
+  by rewrite /= -rr -ac ab.
+rewrite /=; case: ifP=> [/eqP bc | bnc].
+  by rewrite /= -ll -bc ab.
+by rewrite /= ab.
+Qed.
+
+Lemma edge_covered_update_closed_cell g l1 l2 c pt :
+  closed_cell_side_limit_ok c ->
+  edge_covered g l1 (rcons l2 c) ->
+  edge_covered g l1 (rcons l2 (update_closed_cell c pt)).
+Proof.
+move=> cok ecg.
+have lq : left_limit (update_closed_cell c pt) = left_limit c.
+  by case: (c).
+have rq : right_limit (update_closed_cell c pt) = right_limit c.
+  by rewrite update_closed_cell_keeps_right_limit.
+case: ecg => [[oc [pcc [ocP1 [hP [cP [ocin conn]]]]]] | ].
+  left; exists oc, (seq_subst pcc c (update_closed_cell c pt)).
+  split.
+    elim: (pcc) ocP1 => [ // | a l Ih].
+    move=> subh x; rewrite /=.
+    have /Ih {} Ih : {subset l <= rcons l2 c}.
+      by move=> y yin; have /subh : y \in a:: l by rewrite inE yin orbT.
+    case: ifP => [ac | anc]; rewrite !(inE, mem_rcons).
+      by move=> /orP[-> // | /Ih]; rewrite mem_rcons inE.
+    move=> /orP[xa | ].
+      have /subh : x \in a :: l by rewrite inE xa.
+      by rewrite mem_rcons inE (eqP xa) anc /= orbC => ->.
+    by move/Ih; rewrite mem_rcons inE.
+  split.
+    move=> x; rewrite mem_rcons inE => /orP[xoc | ].
+      by apply: hP; rewrite mem_rcons inE xoc.
+    have : {in pcc, forall c, high c = g}.
+      by move=> y yin; apply: hP; rewrite mem_rcons inE yin orbT.
+    elim: (pcc) => [ // | a l Ih] {}hP.
+    have /Ih {}Ih : {in l, forall c, high c = g}.
+      by move=> y yin; apply: hP; rewrite inE yin orbT.
+    rewrite /=; case: ifP=> [ac | anc].
+      rewrite inE=> /orP[/eqP -> | ]; last by [].
+      have: high c = g by apply: hP; rewrite inE eq_sym ac.
+      by case: (c).    
+    rewrite inE=> /orP[/eqP -> | ]; last by [].
+    by apply: hP; rewrite inE eqxx.
+  split.
+    elim/last_ind: (pcc) cP => [// | pcc' lpcc _].
+    rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
+    move=> /andP[] cP cc.
+    rewrite connect_limits_rcons; last first.
+      by case: (pcc')=> /= [ | ? ?]; case: ifP.
+    apply/andP; split; last first.
+      rewrite -cats1 seq_subst_cat /=.
+      move: cc; rewrite last_rcons=> /eqP <-.
+      case: ifP; rewrite cats1 last_rcons; last by [].
+      by rewrite rq => /eqP ->.
+    by apply: connect_limits_seq_subst.
+  split; first by [].
+  case: (pcc) conn => [ | fpcc pcc']/=; first by [].
+  by case: ifP=> [ /eqP -> | ].
+move=> [pcc [P0 [P1 [P2 [P3 [P4 P5]]]]]].
+right.
+exists (seq_subst pcc c (update_closed_cell c pt)).
+split.
+  by rewrite seq_subst_eq0.
+split.
+  elim : (pcc) P1 => [ | a l Ih] P1; first by [].
+  have ain : a \in rcons l2 c by apply: P1; rewrite inE eqxx.
+  have /Ih {} Ih : {subset l <= rcons l2 c}.
+    by move=> y yin; apply: P1; rewrite inE yin orbT.
+  rewrite /=; case: ifP=> [ ac | anc].
+    move=> g'; rewrite !inE => /orP[/eqP -> | /Ih]; last by [].
+    by rewrite mem_rcons inE eqxx.
+  move=> g'; rewrite !inE=> /orP[/eqP -> | ].
+    by move: ain; rewrite !mem_rcons !inE anc /= orbC => ->.
+  by apply: Ih.
+split.
+  elim: (pcc) P2 => [ | a l Ih] P2; first by [].
+  have /Ih {} Ih : {in l, forall c, high c = g}.
+    by move=> x xin; apply: P2; rewrite inE xin orbT.
+  rewrite /=; case: ifP => [ac | anc].
+    move=> c'; rewrite inE => /orP[/eqP -> | ].
+      move: (P2 c); rewrite inE eq_sym ac => /(_ isT).
+      by case: (c).
+    by apply: Ih.
+  move=> c'; rewrite inE => /orP[/eqP -> | ].
+    by apply: P2; rewrite inE eqxx.
+  by apply: Ih.
+split; first by apply: connect_limits_seq_subst.
+split.
+  move: P4; case: (pcc)=> [ | a l]; first by [].
+  rewrite /=; case: ifP=> [/eqP ac | anc] /=; last by [].
+  by rewrite lq ac.
+move: P5; elim/last_ind : (pcc) => [ | l b _]; first by [].
+rewrite -cats1 seq_subst_cat /=; case: ifP=> [/eqP bc | bnc].
+  by rewrite /last_cell !last_cat /= rq bc.
+by rewrite /last_cell !last_cat /=.
+Qed.
+
+Lemma lsthe_at_left : point e <<= lsthe ->
+  p_x (left_pt lsthe) < p_x (point e).
+Proof.
+move=> puh.
+have /lex_open_edges/andP[+ _] : lsthe \in [seq high c | c <- open].
+  by apply/mapP; exists lsto.
+rewrite /lexPt=> /orP[ | /andP[] /eqP samex lty]; first by [].
+have vhe : valid_edge lsthe (point e).
+  move: (allP sval lsto); rewrite /open mem_cat inE eqxx !orbT.
+  by move=> /(_ isT)=> /andP[]; rewrite lstheq.
+move: puh; rewrite under_pvert_y //.
+move: (samex)=> /esym/eqP=> samex'.
+rewrite (same_pvert_y vhe samex').
+by rewrite (on_pvert (left_on_edge _)) leNgt lty.
+Qed.
+
+Lemma step_keeps_edge_covering:
+  let s' :=  step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  forall g, edge_covered g open (rcons cls lstc) \/ g \in outgoing e ->
+  edge_covered g (state_open_seq s') (state_closed_seq s').
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP => [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  rewrite /state_open_seq /state_closed_seq /=.
+  move=> g gin.
+  have := step_keeps_edge_covering_default oe oca_eq gin.
+  by rewrite -!cats1 -?catA /=.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  move: adj rfo sval; rewrite /open -cat_rcons => adj' rfo' sval'.
+  have := open_cells_decomposition_cat adj' rfo' sval' (exi' eabove) eabove'.
+  rewrite oe' cat_rcons => oe.
+  rewrite /state_open_seq /state_closed_seq /=.
+  move=> g gin.
+  have := step_keeps_edge_covering_default oe oca_eq gin.
+  by rewrite !cat_rcons -!cats1 -?catA /=.
+have [p1 [p2 [pts ptsq]]]: exists p1 p2 pts, left_pts lsto = p1 :: p2 :: pts.
+  have ebelow' : point e <<= high lsto.
+    by move/negbFE :ebelow; rewrite lstheq.
+  have := size_left_lsto pxhere palstol ebelow'.
+  case: (left_pts lsto) => [// | pt1 [ // | pt2 pts]] _.
+  by exists pt1, pt2, pts.
+case: ifP => [ebelow_st {ebelow} | eonlsthe].
+  rewrite /update_open_cell/generic_trajectories.update_open_cell.
+  case ogq : (outgoing e) => [ /= | fog ogs].
+    move=> g [ ecg | //].
+    rewrite /state_open_seq /= cats0 /state_closed_seq /=.
+    apply: edge_covered_set_left_pts.
+      by rewrite /left_limit ptsq.
+    apply: edge_covered_update_closed_cell.
+      by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
+    by exact: ecg.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno]  /=.
+    have outn0 : fog :: ogs != nil by [].
+    have oute2 : {in fog :: ogs, forall g, left_pt g == point e}.
+      by rewrite -ogq.
+    have := opening_cells_aux_absurd_case vlo vho outn0 oute2.
+    by rewrite oca_eq.
+  move=> g [ecg | gnew]; last first.
+    left.
+    have :=opening_cells_aux_cover_outgoing vlo.
+    move=> /(_ (high lsto) (fno :: nos) lno); rewrite ogq=> /(_ oca_eq).
+    move=> /(_ g gnew) [gc [P1 [P2 P3]]].
+    exists (if gc == fno then
+               set_left_pts fno (point e :: behead (left_pts lsto))
+            else gc), [::].
+    split; first by [].
+    split.
+      move=> x; rewrite /= inE => /eqP ->.
+      case: ifP => [/eqP <- | ]; last by [].
+      by case: (gc) P2.
+    split; first by [].
+    split.
+      rewrite /state_open_seq /=.
+      move: P1; case: ifP => [/eqP -> _ | ].
+        by rewrite !mem_cat inE eqxx orbT.
+      by rewrite inE=> -> /=; rewrite !mem_cat inE=> ->; rewrite ?orbT.
+    rewrite /head_cell /=; case: ifP=> [/eqP <- | ]; last by [].
+    move: lstxq; rewrite /left_limit.
+    rewrite ptsq /left_limit /= => <-.
+    by rewrite (eqP (@oute g _)) ?pxhere // ogq.
+  move: ecg=> [[oc [pcc [P1 [P2 [P3 [P4 P5]]]]]] | ].
+    move: P4; rewrite mem_cat inE orbCA=> /orP[/eqP oclsto | inold].
+      rewrite /state_open_seq /state_closed_seq /=.
+      rewrite /= -catA /=.
+      apply: edge_covered_set_left_pts.
+        rewrite (opening_cells_left oute vlo vho).
+          by rewrite pxhere lstxq /left_limit ptsq.
+        by rewrite /opening_cells ogq oca_eq mem_rcons !inE eqxx !orbT.
+      apply: edge_covered_update_closed_cell.
+        by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
+      left; exists lno, pcc.
+      split; first by [].
+      split.
+        move=> x; rewrite mem_rcons inE=> /orP[/eqP -> | xin]; last first.
+          by apply P2; rewrite mem_rcons inE xin orbT.
+        have := opening_cells_aux_high_last vlo vho oute'.
+        rewrite ogq oca_eq /= -oclsto=> ->; apply: P2.
+        by rewrite mem_rcons inE eqxx.
+      have left_lno : left_limit lno = lstx.
+        have := opening_cells_left oute vlo vho.
+          rewrite -pxhere /opening_cells ogq oca_eq; apply.
+          by rewrite mem_rcons inE eqxx.
+      split.
+        elim/last_ind: {-1} pcc (erefl pcc)  => [ | pcc' pcl _] pccq;
+          first by [].
+        rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
+        move: P3; rewrite pccq connect_limits_rcons; last first.
+          by apply/eqP/rcons_neq0.
+        move=> /andP[] -> /eqP ->.
+        by rewrite oclsto -lstxq left_lno eqxx.
+      split; first by rewrite !(mem_cat, inE) eqxx !orbT.
+      move: P5; case: (pcc) => //=.
+      by rewrite left_lno oclsto lstxq.
+    rewrite /state_closed_seq /state_open_seq /=.
+    rewrite -!catA /=.
+    have left_fno : left_limit fno = lstx.
+      have := opening_cells_left oute vlo vho.
+      rewrite -pxhere /opening_cells ogq oca_eq; apply.
+      by rewrite mem_rcons !inE eqxx !orbT.
+    apply: edge_covered_set_left_pts.
+      by rewrite left_fno lstxq /left_limit ptsq.
+    apply: edge_covered_update_closed_cell.
+      by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
+    left; exists oc, pcc; repeat (split; first by []); split; last by [].
+    by rewrite !(mem_cat, inE); move: inold=> /orP[] ->; rewrite ?orbT.
+  move=> [pcc [P1 [P2 [P3 [P4 P5]]]]].
+  rewrite /state_open_seq /state_closed_seq /=.
+  apply: edge_covered_update_closed_cell.
+    by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
+  by right; exists pcc; repeat (split; first by []); done.
+rewrite -/(open_cells_decomposition _ _).
+case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+have exi2 : exists2 c, c \in (lsto :: lop) & contains_point' (point e) c.
+  have : contains_point' (point e) lsto.
+    by rewrite /contains_point' palstol -lstheq /point_under_edge (negbFE ebelow).
+  by exists lsto;[rewrite inE eqxx | ].
+have := open_cells_decomposition_cat adj rfo sval exi2.
+rewrite /= oe' => /(_ palstol)=> oe.
+have [ocd [lcc_ctn [all_ct [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe old_nctn]:=
+ decomposition_connect_properties rfo sval adj cbtom bet_e oe.
+rewrite -/(update_open_cell_top _ _ _).
+case uoct_eq: (update_open_cell_top lsto he e) => [nos lno].
+rewrite /state_closed_seq /state_open_seq /= -!catA /=.
+move=> g [ | ]; last first.
+  case ogq : (outgoing e) => [// | fog ogs]; rewrite -ogq => go.
+  move: uoct_eq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top ogq.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos'] lno'].
+    have ogn : fog :: ogs != [::] by [].
+    have := opening_cells_aux_absurd_case vlo vhe ogn.
+    by rewrite -[X in {in X, _}]ogq oca_eq=> /(_ oute).
+  rewrite -ogq in oca_eq.
+  move=> [] <- <-.
+  have [oc [P1 [P2 P3]]] := opening_cells_aux_cover_outgoing vlo oca_eq go.
+  left; exists (if oc == fno then 
+                  set_left_pts fno (point e :: behead (left_pts lsto))
+                else oc), [::].
+  split;[by [] | split;[ | split; [by [] | ]]].
+    case: ifP => [/eqP ocfno | ocnfno]; last first.
+      by move=> x; rewrite mem_rcons !inE=> /orP[/eqP -> | ].
+    move=> x; rewrite inE -ocfno=> /eqP ->.
+    by case: (oc) P2.
+  split.
+    case: ifP => [/eqP ocfno | ocnfno].
+      by rewrite !(mem_cat, inE) eqxx !orbT.
+    by move: P1; rewrite inE ocnfno /= !(mem_cat, inE)=> ->; rewrite !orbT.
+  rewrite /=; case: ifP => [ocfno | ocnfno]; last by [].
+  move: lstxq; rewrite /left_limit ptsq -pxhere /= => <-.
+  by apply/f_equal/esym/(@eqP [eqType of pt])/oute.
+move=> [ | [pcc [P0 [P1 [P2 [P3 [P4 P5]]]]]]]; last first.
+  move: uoct_eq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+  case ogq : (outgoing e) => [ | fog ogs].
+    move=> [] <- <- /=.
+    right; exists pcc; split; [by [] | split; last by []].
+    move=> x /P1; rewrite !(mem_rcons, inE, mem_cat).
+    by move=> /orP[] ->; rewrite ?orbT.
+  rewrite -ogq.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) =>
+       [[ | fno nos'] lno'].
+    have ogn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vhe ogn oute.
+    by rewrite oca_eq.
+  move=> [] <- <-.
+  right; exists pcc.
+  split; first by [].
+  split; last by [].
+  move=> x /P1.
+  by rewrite !(mem_cat, mem_rcons, inE)=> /orP[] ->; rewrite ?orbT.
+move=> [oc [pcc [P1 [P2 [P3 [P4 P5]]]]]].
+move: P4; rewrite /open ocd.
+move=> ocin.
+have olds : [|| oc \in fop, oc \in fc' | (oc \in lc)] ->
+      edge_covered g (fop ++ fc' ++ nos ++ lno :: lc)
+        (rcons (closing_cells (point e) (behead cc) ++ lstc :: cls)
+           (close_cell (point e) lcc)).
+  move=> ocin'; left; exists oc, pcc.
+  split.
+    move=> x /P1; rewrite !(mem_rcons, mem_cat, inE).
+    by move=> /orP[] ->; rewrite ?orbT.
+  do 2 (split; first by []).
+  split; last by [].
+  rewrite !(mem_cat, inE).
+  by move: ocin'=> /orP[-> | /orP[] -> ]; rewrite ?orbT.
+move: ocin; rewrite -!catA !(mem_cat, inE) => /orP[ocin |].
+  by apply: olds; rewrite ocin ?orbT.
+move=> /orP[ocin |]; first by apply: olds; rewrite ocin ?orbT.
+rewrite orbA=> /orP[ | ocin];last by apply: olds; rewrite ocin ?orbT.
+have ealsthe : point e >>= lsthe by rewrite /point_strictly_under_edge eonlsthe.
+have ebelow' : point e <<= lsthe by rewrite /point_under_edge (negbFE ebelow).
+have := last_step_situation oe' pxhere ealsthe ebelow'.
+move=> [-> /= [leo [cc' ccq]] ].
+have ll := lsthe_at_left ebelow'.
+rewrite ccq inE -orbA => /orP[/eqP oclsto | ].
+  have gq : g = lsthe.
+    by rewrite lstheq -oclsto P2 // mem_rcons inE eqxx.
+  have [pcc1 [pcc' pccq]] : exists pcc1 pcc', pcc = pcc1 :: pcc'.
+    case pccq : pcc => [ | pcc1 pcc']; last by exists pcc1, pcc'.
+    move: P5; rewrite pccq /= oclsto -lstxq -pxhere => abs.
+    by rewrite abs gq lt_irreflexive in ll.
+  right; exists pcc.
+    split.
+      by rewrite pccq.
+    split.    
+      move=> x /P1; rewrite !(mem_rcons, mem_cat, inE).
+      by move=> /orP[] -> ; rewrite ?orbT.
+    split.
+      by move=> x xin; apply: P2; rewrite mem_rcons inE xin orbT.
+    split.
+      move: P3; rewrite connect_limits_rcons; last by rewrite pccq.
+      by move=> /andP[].
+    split; first by move: P5; rewrite pccq.
+    move: P3; rewrite connect_limits_rcons; last by rewrite pccq.
+    move=> /andP[] _ /eqP ->.
+    have eon : point e === high lsto.
+      rewrite -lstheq.
+      by apply: under_above_on; first rewrite lstheq.
+    move: (open_non_inner lstoin eon)=> []; last first.
+      rewrite -lstheq gq oclsto => <-.
+      by rewrite -lstxq pxhere.
+    by move: ll=> /[swap] ->; rewrite -lstheq lt_irreflexive.
+    move=> /orP[ | oclcc]; last first.
+  have hlnoq : high lno = high lcc.
+    move: uoct_eq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+    case ogq: (outgoing e) => [| fog ogs]; first by move=> [] _ <- /=.
+    rewrite -ogq.
+    rewrite -/(opening_cells_aux _ _ _ _).
+    case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos'] lno'].
+      have := opening_cells_aux_high_last vle vhe oute'; rewrite leo oca_eq /=.
+      by move=> /[swap] - [] _ <- => ->.
+    have := opening_cells_aux_high_last vle vhe oute'; rewrite leo oca_eq /=.
+    by move=> /[swap] - [] _ <- => ->.
+  have llno : left_limit lno = p_x (point e).
+    move: uoct_eq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+    case ogq: (outgoing e) => [| fog ogs].
+      have:= size_left_lsto pxhere palstol.
+      rewrite -lstheq => /(_ ebelow').
+      move: lstxq; rewrite /left_limit pxhere => -> + [] _ <- /=.
+      by case: (left_pts lsto).
+    rewrite -ogq.
+    rewrite -/(opening_cells_aux _ _ _ _).
+    case oca_eq: opening_cells_aux => [ [ | fno nos'] lno'] [] _ <-;
+      have := opening_cells_left oute vlo vhe; 
+      rewrite /opening_cells oca_eq=> /(_ lno');
+      by rewrite mem_rcons inE eqxx=> /(_ isT).
+  have vlcc : valid_cell lcc (point e).
+    by apply/andP/(allP sval); rewrite /open ocd !(mem_cat, inE) eqxx ?orbT.
+  left; exists lno, (rcons pcc (close_cell (point e) lcc)).
+  split.
+    move=> c; rewrite !(mem_rcons, mem_cat, inE)=> /orP[-> |]; first by [].
+    by move=> /P1; rewrite mem_rcons inE => ->; rewrite !orbT.
+  split.
+    move=> c; rewrite mem_rcons inE => /orP[/eqP -> |].
+      by rewrite hlnoq; apply: P2; rewrite (eqP oclcc) mem_rcons inE eqxx.
+    rewrite mem_rcons inE => /orP[/eqP -> | ].
+      have [_ -> _] := close_cell_preserve_3sides (point e) lcc.
+        by rewrite -(eqP oclcc); apply: P2; rewrite mem_rcons inE eqxx.
+      by move=> cin; apply: P2; rewrite mem_rcons inE cin orbT.
+  split.
+    rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
+    rewrite last_rcons close_cell_right_limit // llno eqxx andbT.
+    case pccq : pcc => [ | pcc1 pcc']; first by [].
+    rewrite connect_limits_rcons //.
+    move: P3; rewrite pccq connect_limits_rcons // => /andP[] -> /=.
+    move=> /eqP ->; rewrite /left_limit (eqP oclcc).
+    by have [_ _ ->] := close_cell_preserve_3sides (point e) lcc.
+  split; first by rewrite !mem_cat inE eqxx !orbT.    
+  rewrite /head_cell !head_rcons.
+  move: P5; rewrite (eqP oclcc) => <-.
+  case: (pcc) => [ /= | ? ?]; last by [].
+  by rewrite left_limit_close_cell.
+move=> ocin.
+have ocin' : oc \in cc by rewrite ccq inE ocin orbT.
+have right_pt_e : right_pt (high oc) = point e.
+  have := open_cells_decomposition_point_on cbtom adj bet_e sval oe ocin'.
+      have ocop : oc \in open by rewrite /open ocd !mem_cat ocin' ?orbT.
+      have := open_non_inner ocop; rewrite /non_inner => /[apply].
+      move=> [ abs |->]; last by [].
+      have : high oc \in [seq high c | c <- open] by apply: map_f.
+      by move=> /lex_open_edges; rewrite abs lexPt_irrefl.
+right; exists (rcons pcc (close_cell (point e) oc)).
+split.
+  by apply/eqP/rcons_neq0.
+split.
+  have clocin : close_cell (point e) oc \in closing_cells (point e) cc'.
+    by apply: map_f.
+  move=> c; rewrite !(mem_rcons, mem_cat, inE)=> /orP[ /eqP -> | /P1].
+    by rewrite clocin ?orbT.
+  by rewrite mem_rcons inE=> ->; rewrite !orbT.
+split.
+  move=> c; rewrite mem_rcons inE => /orP[/eqP -> | ].
+    have [_ -> _] := close_cell_preserve_3sides (point e) oc.
+    by apply: P2; rewrite mem_rcons inE eqxx.
+  by move=> cin; apply: P2; rewrite mem_rcons inE cin orbT.
+split.
+  case pccq : pcc => [ | pcc1 pcc']; first by [].
+  rewrite connect_limits_rcons /left_limit; last by [].
+  have [_ _ ->] := close_cell_preserve_3sides (point e) oc.
+  by move: P3; rewrite pccq connect_limits_rcons.
+split.
+  case pccq : pcc => [ | pcc1 pcc'] /=.
+    move: P5; rewrite pccq /= /left_limit.
+    by have [_ _ ->] := close_cell_preserve_3sides (point e) oc.
+  by move: P5; rewrite pccq.
+rewrite /last_cell last_rcons close_cell_right_limit; last first.
+  by apply/andP/(allP sval); rewrite /open ocd !mem_cat ocin' !orbT.
+rewrite P2 in right_pt_e; last by rewrite mem_rcons inE eqxx.
+by rewrite right_pt_e.
+Qed.
+
+Lemma step_keeps_subset_default:
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  {subset [seq high c | c <- fc ++ nos ++ lno :: lc]
+       <= [seq high c | c <- open] ++ outgoing e}.
+Proof.
+case oe : (open_cells_decomposition _ _) =>
+ [[[[[fc cc] lcc] lc] le] he].
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos lno].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vl vp nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+move=> g; rewrite ocd -2!cat_rcons !map_cat /= !(mem_cat, inE).
+rewrite orbCA=> /orP[ | gold]; last first.
+  by apply/orP; left; rewrite orbCA gold orbT.
+suff -> : [seq high c | c <- rcons nos lno] =i rcons (outgoing e) he.
+  by rewrite map_rcons !mem_rcons !inE heq=> /orP[-> | ->]; rewrite !orbT.
+have := opening_cells_aux_high vl vp oute'; rewrite oca_eq /=.
+rewrite map_rcons=> -> g'; rewrite !mem_rcons !inE mem_sort; congr (_ || _).
+by have := opening_cells_aux_high_last vl vp oute'; rewrite oca_eq /= => ->.
+Qed.
+
+Lemma step_keeps_subset : 
+  let s' :=  step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {subset [seq high c | c <- state_open_seq s'] <=
+    [seq high c | c <- open] ++ outgoing e}.
+Proof.
+rewrite /step/=/generic_trajectories.simple_step.
+case: ifP => [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+rewrite /state_open_seq /= -catA.
+  by have := step_keeps_subset_default; rewrite oe oca_eq.
+case: ifP=> [eabove | ebelow].
+  rewrite -/(open_cells_decomposition _ _).
+  case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+  have eabove' : point e >>> low (head dummy_cell lop).
+    have llopq : low (head dummy_cell lop) = lsthe.
+      apply: esym; rewrite lstheq.
+      move: (exi' eabove)=> [w + _].
+      move: adj=> /adjacent_catW[] _.
+      by case: (lop) => [ // | ? ?] /andP[] /eqP.
+    by rewrite llopq.
+  move: adj rfo sval; rewrite /open -cat_rcons => adj' rfo' sval'.
+  have := open_cells_decomposition_cat adj' rfo' sval' (exi' eabove) eabove'.
+  rewrite oe' cat_rcons => oe.
+  rewrite /state_open_seq /= -!catA /=.
+  have := step_keeps_subset_default.
+  by rewrite oe oca_eq; rewrite cat_rcons -!catA.
+have ebelow' : point e <<= lsthe by exact (negbFE ebelow).
+case: ifP => [ebelow_st | enolsthe].
+  have belowo : point e <<< high lsto by rewrite -lstheq.
+  have := open_cells_decomposition_single adj rfo sval palstol belowo.
+  move=> oe.
+  have [ocd [lcc_ctn [_ [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+  have [pal puh vl vp nc]:=
+   decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+  rewrite /update_open_cell/generic_trajectories.update_open_cell /state_open_seq.
+  case ogq: (outgoing e) => [ | fog ogs] /=.
+    have := step_keeps_subset_default; rewrite oe ogq /=.
+    rewrite !cats0.
+    do 2 rewrite -/(vertical_intersection_point _ _).
+    by rewrite (pvertE vl) (pvertE vp) /= !map_cat /=.
+  have := step_keeps_subset_default; rewrite oe ogq /=.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [ [ | fno nos'] lno'] /=.
+    have := opening_cells_aux_absurd_case vl vp => /(_ (fog :: ogs) isT).
+    by rewrite -ogq => /(_ oute); rewrite ogq oca_eq.
+  move=> main g gin; apply: main; move: gin.
+  by repeat (rewrite !map_cat /=); rewrite -!catA.
+rewrite -/(open_cells_decomposition _ _).
+case oe' : (open_cells_decomposition _ _) => [[[[[fc' cc] lcc] lc] le] he].
+rewrite -/(update_open_cell_top _ _ _).
+case uoctq: update_open_cell_top => [nos lno].
+rewrite /state_open_seq /= -!catA.
+move=> g /mapP [c cin gq]; rewrite gq {gq}.
+have exi2 : exists2 c, c \in lsto :: lop & contains_point' (point e) c.
+  exists lsto; first by rewrite inE eqxx.
+  by rewrite /contains_point' palstol -lstheq ebelow'.
+have := open_cells_decomposition_cat adj rfo sval exi2 palstol.
+rewrite oe'=> oe.
+have [ocd [lcc_ctn [_ [all_nct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vl vp nc]:=
+   decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+have := last_step_situation oe' pxhere (negbT enolsthe) ebelow'.
+move=> [fc'0 [leo [cc' ccq]]].
+case ogq : (outgoing e) => [ | fog ogs]; last first.
+  move: uoctq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  case oca_eq : (opening_cells_aux _ _ _ _) => [ [ | fno nos'] lno'].
+    have ogn : outgoing e != [::] by rewrite ogq.
+    have := opening_cells_aux_absurd_case vlo vp ogn oute.
+    by rewrite oca_eq.
+  rewrite ogq.
+  have := step_keeps_subset_default; rewrite oe.
+  rewrite leo oca_eq fc'0 cats0 /= -ogq.
+  move=> main [] nosq lnoq; apply: main.
+  move: cin; rewrite mem_cat map_cat=> /orP[cin |cin].
+    by rewrite mem_cat map_f.
+  rewrite 2!mem_cat inE fc'0 /= -nosq inE -orbA in cin.
+  rewrite mem_cat /=; apply/orP; right.
+  move: cin=> /orP[/eqP -> | cin].
+    by rewrite high_set_left_pts inE eqxx.
+  rewrite inE; apply/orP; right.
+  by apply/map_f; rewrite mem_cat inE lnoq.
+move: uoctq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top ogq => -[] nosq lnoq.
+move: cin; rewrite /open ocd fc'0 -nosq !cats0 /= mem_cat.
+rewrite map_cat inE mem_cat.
+move=> /orP[cin | cin].
+  by rewrite map_f.
+apply/orP; right.
+rewrite map_cat mem_cat; apply/orP; right.
+move: cin=> /orP[/eqP -> | cin].
+  by rewrite -lnoq /= heq inE eqxx.
+by rewrite /= inE map_f ?orbT.
+Qed.
+
+(* Keeping as a record that this statement should be proved.  However,
+  since this statement is not used yet, we do not start a proof. *)
+Definition TODO_step_keeps_left_pts_inf :=
+  let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {in state_open_seq s', forall c, lexPt (bottom_left_corner c) (point e)}.
+
+Lemma step_keeps_left_limit_has_right_limit_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  {in fc ++ nos ++ lno :: lc, 
+   forall c p, inside_box p -> left_limit c = p_x p ->
+     contains_point' p c ->
+     has (inside_closed' p) 
+      (cls ++ lstc :: rcons (closing_cells (point e) cc)
+         (close_cell (point e) lcc))}.
+Proof.
+case oe : (open_cells_decomposition _ _) =>
+ [[[[[fc cc] lcc] lc] le] he].
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos lno].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vl vp nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+remember (fc ++ nos ++ lno :: lc) as open' eqn:openeq.
+remember (cls ++ lstc :: rcons (closing_cells (point e) cc)
+           (close_cell (point e) lcc)) as closed' eqn:closeeq.
+have := invariant1_default_case.
+  rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'. 
+move=> c cin pt' inboxp lbnd pin.
+move: cin; rewrite openeq -cat_rcons !mem_cat orbCA orbC=> /orP[cold | cnew].
+  rewrite closeeq -cat_rcons has_cat; apply/orP; left.
+  apply: (left_limit_has_right_limit _ inboxp lbnd pin).
+  by rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+have lcco : lcc \in open.
+  by rewrite ocd !(mem_cat, inE) eqxx !orbT.
+have ppe : p_x pt' = p_x (point e).
+  have := (opening_cells_left oute vl vp); rewrite /opening_cells oca_eq.
+  by rewrite -lbnd; apply.
+have adjcc : adjacent_cells cc.
+  by move: adj; rewrite ocd=> /adjacent_catW[] _ /adjacent_catW[].
+have valcc : seq_valid cc (point e).
+  by apply/allP=> x xin; apply: (allP sval); rewrite ocd !mem_cat xin ?orbT.
+have lonew : low (head dummy_cell
+                 (opening_cells (point e) (outgoing e) le he)) = le.
+  have := adjacent_opening_aux vl vp oute'; rewrite /opening_cells oca_eq.
+  by move=> /(_ _ _ erefl) [].
+have lonew' : head dummy_edge
+    [seq low c | c <- opening_cells (point e) (outgoing e) le he] = le.
+  move: (opening_cells_not_nil (outgoing e) le he) lonew.
+  by set w := opening_cells _ _ _ _; case: w=> [ | a tl].
+have highnew : [seq high i | i <- opening_cells (point e)(outgoing e) le he]=
+               rcons (sort (@edge_below _) (outgoing e)) he.
+  by rewrite (opening_cells_high vl vp).
+have allval : all (fun g => valid_edge g pt')
+     (head dummy_edge [seq low i | i <- opening_cells (point e) 
+              (outgoing e) le he] ::
+     [seq high i | i <- opening_cells (point e) (outgoing e) le he]).
+  apply/allP=> x; rewrite inE=> xin.
+  suff : valid_edge x (point e) by rewrite /valid_edge/generic_trajectories.valid_edge ppe.
+  move: xin=> /orP[/eqP xin | xin]; first by rewrite xin lonew'.
+  rewrite (opening_cells_high vl vp) // ?mem_rcons inE mem_sort in xin.
+  case/orP: xin=> [/eqP -> // | xin ].
+  apply: valid_edge_extremities; apply/orP; left.
+  by apply: oute.
+set lec := head lcc cc.
+have [cc' ccq] : exists cc', rcons cc lcc = lec :: cc'.
+  rewrite /lec; case: (cc) => [ | a b]; first by exists [::].
+  by exists (rcons b lcc).
+have lecc : lec \in rcons cc lcc by rewrite ccq inE eqxx.
+have lecin : lec \in open.
+  by rewrite ocd -cat_rcons !mem_cat lecc ?orbT.
+have vhlece : valid_edge (high lec) (point e).
+  by have := seq_valid_high sval (map_f high lecin).
+have vhlecp : valid_edge (high lec) pt'.
+  by move: vhlece; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
+move: adj'; rewrite -catA -cat_rcons =>
+  /adjacent_catW[] _ /adjacent_catW[] adjo _.
+have adjo' : adjacent_cells (opening_cells (point e) (outgoing e) le he).
+  by rewrite /opening_cells oca_eq.
+have [yle | yabove] := lerP (p_y pt') (p_y (point e)).
+  have pale : pt' >>> le.
+    have /mem_seq_split [s1 [s2 s1s2q]] := cnew.
+    case s1q : s1 => [ | c0 s1'].
+      move: lonew; rewrite /opening_cells oca_eq s1s2q s1q /= => <-.
+      by move: pin=> /andP[].
+    have lco : low c \in outgoing e.
+      have := seq_low_high_shift
+                (opening_cells_not_nil (outgoing e) le he (point e))
+                adjo'.
+      rewrite /opening_cells oca_eq /= s1s2q s1q /= => - [].
+      rewrite -[RHS]/[seq high i | i <- (c0 :: s1') ++ c :: s2] -s1q -s1s2q.
+      move: (opening_cells_high vl vp oute); rewrite /opening_cells oca_eq.
+      move=> ->=> /rcons_inj [] lows _.
+      have : low c \in [seq low i | i <- s1' ++ c :: s2].
+        by apply: map_f; rewrite mem_cat inE eqxx orbT.
+      by rewrite lows mem_sort.
+    have vlce : valid_edge (low c) (point e).
+      by apply: valid_edge_extremities; rewrite (oute lco).
+    move: pin => /andP[] + _; rewrite under_pvert_y; last first.
+      by move: vlce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
+    rewrite -(same_pvert_y vlce); last by apply/eqP.
+    by rewrite on_pvert ?yle // -(eqP (oute lco)) // left_on_edge.
+  have plec : contains_point' pt' lec.
+    rewrite /contains_point' -leq pale.
+    rewrite under_pvert_y //.
+    apply: (le_trans yle).
+    rewrite -(same_pvert_y vhlece); last by apply/eqP.
+    rewrite -under_pvert_y //.
+    case ccq': cc => [ | cc0 ccs].
+      by move: ccq; rewrite ccq' /= => -[] <- _; rewrite -heq; apply/underW.
+    suff/allct/andP[] : lec \in cc by [].
+    by move: ccq; rewrite ccq' /= => -[] -> _; rewrite inE eqxx.
+  have [/eqP lbnd' | safe] := boolP(left_limit lec == p_x pt').
+    rewrite closeeq has_cat.
+    have := (left_limit_has_right_limit lecin inboxp lbnd' plec).
+    move=> /hasP[x]; rewrite mem_rcons inE => /orP[] xin xP.
+      by apply/orP; right; apply/hasP; exists x=> //; rewrite inE xin.
+    by apply/orP; left; apply/hasP; exists x.
+  have lbnd2 : left_limit lec < p_x pt'.
+    rewrite lt_neqAle safe /=.
+    rewrite ppe; apply/lexePt_xW/lexPtW.
+    by apply: (btm_left lecin).
+  rewrite closeeq has_cat; apply/orP; right.
+  apply/hasP; exists (close_cell (point e) lec).
+    rewrite inE; apply/orP; right; rewrite /closing_cells -map_rcons.
+    by apply:map_f; rewrite ccq inE eqxx.
+  have vlec : valid_cell lec (point e).
+    by apply/andP/(allP sval).
+  rewrite inside_closed'E /left_limit.
+  have [-> -> ->]:= close_cell_preserve_3sides (point e) lec.
+  move: plec=> /andP[] -> ->.
+  by rewrite (close_cell_right_limit) // lbnd2 ppe lexx.
+have plcc : contains_point' pt' lcc.
+  have puhe : pt' <<= he.
+    have /mem_seq_split [s1 [s2 s1s2q]] := cnew.
+    elim /last_ind: {2} (s2) (erefl s2) => [ | s2' c2 _] s2q.
+      move: highnew; rewrite /opening_cells oca_eq s1s2q s2q cats1 map_rcons.
+      move=>/rcons_inj[] _ <-.
+      by move: pin => /andP[].
+    have hco : high c \in outgoing e.
+      have := opening_cells_high vl vp oute.
+      rewrite /opening_cells oca_eq s1s2q s2q.
+      rewrite (_ : [seq high i | i <- s1 ++ c :: rcons s2' c2] =
+             rcons [seq high i | i <- s1 ++ c :: s2'] (high c2)); last first.
+        by rewrite !map_cat /= map_rcons -!cats1 /= -!catA /=.
+      move=> /rcons_inj[] his _.
+      have : high c \in [seq high i | i <- s1 ++ c :: s2'].
+        by apply: map_f; rewrite mem_cat inE eqxx orbT.
+      by rewrite his mem_sort.
+    have vhce : valid_edge (high c) (point e).
+      by apply: valid_edge_extremities; rewrite (oute hco).
+    move: (pin) => /andP[] _; rewrite under_pvert_y; last first.
+      by move: vhce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
+    rewrite -(same_pvert_y vhce); last by apply/eqP.
+    rewrite on_pvert; last first.
+      by rewrite -(eqP (oute hco)) // left_on_edge.
+    move=> ple.
+    have ppe': p_y pt' = p_y (point e).
+      by apply: le_anti; rewrite ple (ltW yabove).
+    have/eqP -> : pt' == point e :> pt by rewrite pt_eqE ppe ppe' !eqxx.
+    by apply/underW.
+  rewrite /contains_point'; rewrite -heq puhe andbT.
+  have vllcce : valid_edge (low lcc) (point e).
+    by apply: (seq_valid_low sval); apply/map_f.
+  have vllccp : valid_edge (low lcc) pt'.
+    by move: vllcce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
+  rewrite under_pvert_y // -?ltNge.
+  apply: le_lt_trans yabove.  
+  rewrite -(same_pvert_y vllcce); last by apply/eqP.
+  rewrite leNgt -strict_under_pvert_y //.
+  by have /andP[] := lcc_ctn.
+have [/eqP lbnd' | safe] := boolP(left_limit lcc == p_x pt').
+  rewrite closeeq has_cat /= orbA.
+  have := left_limit_has_right_limit lcco inboxp lbnd' plcc.
+  move/hasP=> [x]; rewrite mem_rcons inE=> /orP[/eqP -> ->| xin xP].
+    by rewrite orbT.
+  by apply/orP; left; apply/orP; left; apply/hasP; exists x.
+have lbnd2 : left_limit lcc < p_x pt'.
+  rewrite lt_neqAle safe /=.
+  rewrite ppe; apply/lexePt_xW/lexPtW.
+  by apply: (btom_left_corners lcco).
+rewrite closeeq has_cat; apply/orP; right.
+apply/hasP; exists (close_cell (point e) lcc).
+  by rewrite inE mem_rcons inE eqxx ?orbT.
+have vlcc : valid_cell lcc (point e).
+  by apply/andP/(allP sval).
+rewrite inside_closed'E /left_limit.
+have [-> -> ->]:= close_cell_preserve_3sides (point e) lcc.
+move: plcc=> /andP[] -> ->.
+by rewrite (close_cell_right_limit) // lbnd2 ppe lexx.
+Qed.
+
+(* This statement is the normal lifting of the previous statement from
+ the default case to the complete step function.  However, this proof
+ is not used for now, so we make it a definition just to keep in records what
+ should be the lemma statement. *)
+Definition TODO_step_keeps_cover_left_border :=
+  let s' :=  step (Bscan fop lsto lop cls lstc lsthe lstx) e in
+  {in state_open_seq s', forall c p, inside_box p -> left_limit c = p_x p ->
+     contains_point' p c ->
+     has (inside_closed' p) (state_closed_seq s')}.
+(*
+Proof.
+have [ + [+ [+ []]]] := step_keeps_invariant1.
+set open0 := state_open_seq _ => + + + + + step_res c cin pt.
+have := step_keeps_left_pts_inf.
+have noc' : {in cell_edges open ++ outgoing e &, no_crossing R}.
+  by move=> g1 g2 g1in g2in; apply: noc; rewrite /= !mem_cat orbA
+   -2!mem_cat ?g1in ?g2in.
+*)
+
+(* The following statement is not necessary for a safety statement, since a
+  vertical cell decomposition that returns an empty list of cells would indeed
+  return only cells whose interior is safe. *)
+
+Lemma step_keeps_cover_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  cover_left_of p (fc ++ nos ++ lno :: lc)
+    (cls ++ lstc :: rcons (closing_cells (point e) cc)
+         (close_cell (point e) lcc)).
+Proof.
+case oe : (open_cells_decomposition _ _) =>
+ [[[[[fc cc] lcc] lc] le] he].
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos lno].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have oc_eq : opening_cells (point e) (outgoing e) le he = rcons nos lno.
+  by rewrite /opening_cells oca_eq.
+have [pal puh vl vp nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+remember (fc ++ nos ++ lno :: lc) as open' eqn:openeq.
+remember (cls ++ lstc :: rcons (closing_cells (point e) cc)
+           (close_cell (point e) lcc)) as closed' eqn:closeeq.
+have := invariant1_default_case.
+rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'. 
+have := step_keeps_left_limit_has_right_limit_default.
+have := step_keeps_btom_left_corners_default.
+rewrite oe oca_eq -openeq.
+move=> btm_left' left_border_in'.
+move=> q inbox_q limrq.
+have [qright | qleft] := boolP(lexPt (point e) q).
+  rewrite /inside_box in inbox_q.
+  move: (inbox_q) => /andP[] bet_q _.
+  have [c cin ctn]:= exists_cell cbtom' adj' bet_q.
+  move: cin.
+
+  have subpq1 : subpred (lexePt p) (lexePt q).
+    by move=> x px; apply/(lexePt_trans limrq).
+  have limr : all (lexePt p) [seq point x | x <- future_events].
+    by apply/allP=> x /mapP [ev evc ->]; apply: plexfut.
+  have limrq1 := sub_all subpq1 limr.
+  rewrite -catA -cat_rcons !mem_cat orbCA -mem_cat=> /orP[] cin; last first.
+    have [inc | ninc] := boolP(inside_open' q c).
+      apply/orP; left;  rewrite openeq -cat_rcons !has_cat orbCA -has_cat.
+      by apply/orP; right; apply/hasP; exists c.
+    have cin0 : c \in open.
+     by rewrite ocd -cat_rcons !mem_cat orbCA -mem_cat cin ?orbT.
+    have cin1 : c \in open'.
+      by rewrite openeq -cat_rcons !mem_cat orbCA -mem_cat cin orbT.
+    apply/orP; right.
+    rewrite closeeq -cat_rcons has_cat; apply/orP; left.
+    move: ninc; rewrite inside_open'E; rewrite lt_neqAle.
+    move: (ctn)=> /andP[] -> -> /=.
+    have -> : left_limit c <= p_x q.
+      have : p_x (point e) <= p_x q by apply/lexePt_xW/lexPtW.
+      apply: le_trans.
+      rewrite /left_limit -[X in X <= _]/(p_x (bottom_left_corner c)).
+      by apply/lexePt_xW/lexPtW; apply: btm_left.
+   have -> : p_x q <= open_limit c.
+      rewrite /open_limit le_min.
+      have extg :
+         forall g, g \in [:: bottom; top] -> p_x q <= p_x (right_pt g).
+        move: inbox_q=> /andP[] _ /andP[] /andP[] _ /ltW + /andP[] _ /ltW.
+        by move=> A B g; rewrite !inE=> /orP[] /eqP ->.
+      have intg g : has (event_close_edge g) future_events ->
+           p_x q <= p_x (right_pt g).
+        move=>/hasP[] ev' ev'in /eqP ->.
+        by apply/lexePt_xW/(lexePt_trans limrq)/(allP limr)/map_f.
+      move: clae'; rewrite -catA -openeq=> /allP /(_ _ cin1) /andP[].
+      by move=> /orP[/extg | /intg] -> /orP[/extg | /intg] ->.
+    rewrite !andbT negbK => /eqP atll.
+    by apply: (left_limit_has_right_limit _ inbox_q atll ctn).
+
+  have limrq' : forall e, e \in future_events -> lexePt q (point e).
+    by move/(sub_all subpq1): (limr); rewrite all_map=>/allP.
+  have [vertp | rightofp] : left_limit c = p_x q \/ left_limit c < p_x q.
+      have cin' :  c \in opening_cells (point e) (outgoing e) le he.
+        by rewrite oc_eq.
+      rewrite (opening_cells_left oute vl vp cin').
+      move: qright=> /lexPtW/lexePt_xW; rewrite le_eqVlt=> /orP[/eqP -> | ->].
+        by left.
+      by right.
+    rewrite closeeq (left_border_in' _ _ _ _ vertp ctn) ?orbT //.
+    by rewrite openeq -cat_rcons !mem_cat cin ?orbT.
+  apply/orP; left; rewrite openeq -cat_rcons; rewrite !has_cat.
+  apply/orP; right; apply/orP; left.
+  apply/hasP; exists c=> //.
+  rewrite inside_open'E rightofp /open_limit le_min.
+  have [/andP[_ ->] /andP[_ ->]] : valid_cell c q.
+    have := opening_valid oute vl vp=> /allP; rewrite oc_eq=> /(_ c cin).
+    move=> /andP[] vlce vhce.
+    have := (allP clae' c); rewrite -catA -cat_rcons !mem_cat cin orbT.
+    move=> /(_ isT).
+    move=> /andP[] end_edge_lc end_edge_hc.
+    have :=
+      valid_between_events (lexPtW qright) limrq' vlce inbox_q end_edge_lc.
+    have :=
+      valid_between_events (lexPtW qright) limrq' vhce inbox_q end_edge_hc.
+    move=> vhcq vlcq.
+    by split.
+  by move: ctn=> /andP[] -> ->.
+have qe : p_x q <= p_x (point e).
+  by apply: lexePt_xW; rewrite lexePtNgt.
+have inclosing : forall c, c \in cc -> inside_open' q c ->
+  (forall c, c \in cc -> valid_edge (low c) (point e) &&
+     (valid_edge (high c) (point e))) ->
+  exists2 c', c' \in closing_cells (point e) cc & inside_closed' q c'.
+  move=> c cin ins allval.
+  exists (close_cell (point e) c).
+    by apply: map_f.
+  move: ins; rewrite inside_open'E andbA=>/andP[] ctn /andP[liml _] /=.
+  move: ctn=>/andP [qlc qhc].
+  rewrite /contains_point/close_cell /=.
+  have [p1 vip1] := exists_point_valid (proj1 (andP (allval _ cin))).
+  have [p2 vip2] := exists_point_valid (proj2 (andP (allval _ cin))).
+  have [onl x1] := intersection_on_edge vip1.
+  have [onh x2] := intersection_on_edge vip2.
+  by rewrite inside_closed'E vip1 vip2 qlc qhc; case: ifP=> [p1e | p1ne];
+    case: ifP=> [p2e | p2ne]; rewrite liml /right_limit /= -?x2 -?x1.
+(* TODO : inclosing and inclosel could probably be instances of a single
+  statement. maybe replacing cc with rcons cc lcc in the statement of
+  inclosing. *)
+have inclosel : inside_open' q lcc ->
+  inside_closed' q (close_cell (point e) lcc).
+  rewrite inside_open'E andbA=> /andP[] /andP[qlc qhc] /andP[liml _] /=.
+  have lccin : lcc \in open by rewrite ocd !mem_cat inE eqxx ?orbT.
+  have [p1 vip1] := exists_point_valid (proj1 (andP (allP sval _ lccin))).
+  have [p2 vip2] := exists_point_valid (proj2 (andP (allP sval _ lccin))).
+  have [onl x1] := intersection_on_edge vip1.
+  have [onh x2] := intersection_on_edge vip2.
+  by rewrite inside_closed'E /close_cell vip1 vip2 qlc qhc /=;
+    case: ifP=> [p1e | p1ne]; case: ifP=> [p2e | p2ne];
+    rewrite liml /right_limit /= -?x2 -?x1.
+move: qleft; rewrite -lexePtNgt lexePt_eqVlt.
+have svalcc :
+   forall c : cell,
+     c \in cc -> valid_edge (low c) (point e) && valid_edge (high c) (point e).
+   by move=> x xin; apply: (allP sval); rewrite ocd !mem_cat xin orbT.
+move=> /orP[/eqP qe' | qlte ].
+  rewrite qe'.
+  apply/orP; right; apply/hasP.
+  set opc := head lcc cc.
+  have opcin' : opc \in open.
+    rewrite ocd -cat_rcons !mem_cat orbCA; apply/orP; left.
+    by rewrite /opc; case: (cc)=> [ | ? ?]; rewrite /= inE eqxx.
+  have adjcc : adjacent_cells cc.
+    by move: adj; rewrite ocd => /adjacent_catW[] _ /adjacent_catW[].
+  have opc_ctn' : contains_point' (point e) opc.
+    rewrite /contains_point' -leq pal /=.
+    case ccq : cc => [ | c1 cc']; rewrite /opc ccq /=.
+      by rewrite -heq; apply underW.
+    by have /allct/andP[] : c1 \in cc by rewrite ccq inE eqxx.
+  have [leftb | ] :=
+    boolP(p_x (last dummy_pt (left_pts opc)) < p_x (point e)); last first.
+    move=> nleftb.
+    have := btom_left_corners opcin';rewrite /bottom_left_corner.
+    rewrite /lexPt (negbTE nleftb) /= => /andP[/eqP sx yl].
+    have /hasP[x xin xP] :=
+      left_limit_has_right_limit opcin' inbox_e sx opc_ctn'.
+    exists x=> //.
+    by rewrite closeeq -cat_rcons mem_cat xin.
+  have : inside_open' (point e) opc.
+    have elt: all (lexePt (point e)) [seq point e0 | e0 <- e :: future_events].
+      rewrite /=; rewrite lexePt_eqVlt eqxx /=.
+      move: sort_evs; rewrite path_sortedE; last exact: lexPtEv_trans.
+      move=> /andP[cmpE _]; apply/allP=> x /mapP[ev evin ->].
+      by apply/lexPtW/(allP cmpE).
+    by apply: (contains_to_inside_open' sval clae inbox_e leftb).
+  move: (opc_ctn').
+  rewrite -qe'=> einopc einop'.
+  case ccq : cc => [ | cc1 cc'] /=.
+    exists (close_cell (point e) lcc).
+      by rewrite closeeq !(mem_cat, inE, mem_rcons) eqxx ?orbT.
+    by apply: inclosel; move: einop'; rewrite /opc ccq.
+  have opcincc : opc \in cc by rewrite /opc ccq /= inE eqxx.
+  have [it itin itP]:= inclosing opc opcincc einop' svalcc.
+  exists it; last by [].
+  by rewrite closeeq mem_cat inE mem_rcons inE itin ?orbT.
+have /orP[| already_closed]:=
+    cover_left_of_e inbox_q (lexPtW qlte); last first.
+  by rewrite closeeq -cat_rcons has_cat already_closed orbT.
+rewrite openeq ocd -2!cat_rcons 2!has_cat orbCA.
+move=> /orP[/hasP[opc opcin qinopc] | keptopen].
+  move: opcin; rewrite mem_rcons inE=> /orP[opclcc | opcin]; last first.
+    have [it it1 it2] := inclosing _ opcin qinopc svalcc.
+    apply/orP; right; apply/hasP.
+    by exists it=> //; rewrite closeeq !(inE, mem_cat, mem_rcons) it1 ?orbT.
+  apply/orP; right; apply/hasP; exists (close_cell (point e) lcc).
+    by rewrite closeeq !(mem_cat, inE, mem_rcons) eqxx ?orbT. 
+  by apply: inclosel; rewrite -(eqP opclcc).
+apply/orP; left; apply/hasP.
+move: keptopen; rewrite -has_cat=>/hasP[it + it2].
+by rewrite mem_cat=> infclc; exists it; rewrite // !mem_cat orbCA infclc orbT.
+Qed.
+
+Lemma step_keeps_right_limit_closed_default :
+  let '(fc, cc, lcc, lc, le, he) :=
+    open_cells_decomposition open (point e) in
+    let '(nos, lno) := opening_cells_aux (point e)
+       (sort (@edge_below _) (outgoing e)) le he in
+  {in  rcons(cls ++ 
+          lstc :: closing_cells (point e) cc) (close_cell (point e) lcc) &
+     future_events, forall c e, right_limit c <= p_x (point e)}.
+Proof.
+case oe : (open_cells_decomposition _ _) =>
+ [[[[[fc cc] lcc] lc] le] he].
+case oca_eq:(opening_cells_aux _ _ _ _) => [nos lno].
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+move=> c ev; rewrite mem_rcons=> cin evin.
+suff rl_ev' : right_limit c <= p_x (point e).
+  apply: (le_trans rl_ev').
+  move: sort_evs; rewrite /= path_sortedE; last by apply: lexPtEv_trans.
+  move=> /andP[] /allP /(_ ev evin) /orP[/ltW // | /andP[] /eqP -> _] _.
+  by apply: le_refl.
+have := sval; rewrite ocd /seq_valid !all_cat=> /andP[] _ /andP[] svalcc /=.
+move=> /andP[] /andP[] vllcc vhlcc _.
+move: cin; rewrite inE => /orP[/eqP -> | ].
+  by have := right_limit_close_cell vllcc vhlcc=> ->; apply: le_refl.
+rewrite mem_cat=> /orP[cold | ].
+  by apply: closed_right_limit; rewrite mem_rcons inE cold orbT.
+rewrite inE=> /orP[cold | ].
+  by apply: closed_right_limit; rewrite mem_rcons inE cold.
+move=> /mapP [c' c'in ->].
+have /andP[vlc' vhc'] := allP svalcc c' c'in.
+by rewrite (right_limit_close_cell vlc' vhc') le_refl.
+Qed.
+
+(* TODO : move to other file *)
+Lemma close_cell_in (p' : pt) c :
+  valid_cell c p' ->
+  p' \in (right_pts (close_cell p' c): seq pt).
+Proof.
+move=> [] vl vh.
+rewrite /close_cell; rewrite (pvertE vl) (pvertE vh) /=.
+by case: ifP=> [/eqP <- | ];
+  case: ifP=> [/eqP <- // | _ ]; rewrite !inE eqxx ?orbT.
+Qed.
+
+Lemma last_closing_side_char pp fc cc lcc lc le he :
+  open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
+  cc != [::] ->
+  in_safe_side_right pp (close_cell (point e) lcc) =
+   [&& p_x pp == p_x (point e), p_y (point e) < p_y pp & pp <<< he].
+Proof.
+move=> oe ccn0.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+have lccin : lcc \in open by rewrite ocd !(mem_cat, inE) eqxx !orbT.
+have /andP [vlcc vhcc] : valid_edge (low lcc) (point e) &&
+  valid_edge (high lcc) (point e) by apply: (allP sval).
+have := right_limit_close_cell vlcc vhcc.
+rewrite /in_safe_side_right.
+move=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [-> -> _] := close_cell_preserve_3sides (point e) lcc.
+rewrite -heq.
+have eonllcc : (point e) === low lcc.
+  have := open_cells_decomposition_point_on cbtom adj 
+            (inside_box_between inbox_e) sval oe.
+  elim /last_ind: {-1} (cc) (erefl cc) ccn0 => [ | cc' cc2 _] ccq // _.
+  have : cc2 \in rcons cc' cc2 by rewrite mem_rcons mem_head.
+  move=> + /(_ cc2) =>/[swap] /[apply].
+  move: adj; rewrite ocd ccq cat_rcons; do 2 move =>/adjacent_catW[] _. 
+  by move=> /= /andP[] /eqP ->.
+have vppl : valid_edge (low lcc) pp.
+  by rewrite (same_x_valid _ samex).
+have vpphe : valid_edge he pp.
+  by rewrite (same_x_valid _ samex).
+rewrite (under_pvert_y vppl) (same_pvert_y vppl samex) -ltNge.
+rewrite (on_pvert eonllcc).
+rewrite (andbC _ (pp <<< he)).
+have [ppuh | ] := boolP (pp <<< he); last by [].
+have [ppae | ] := boolP (p_y (point e) < p_y pp); last by [].
+rewrite /right_pts/close_cell (pvertE vlcc) (pvertE vhcc) /=.
+rewrite !pt_eqE !eqxx /=.
+rewrite (on_pvert eonllcc) eqxx.
+rewrite -heq; move: (puh).
+rewrite (strict_under_pvert_y vhe) lt_neqAle eq_sym=>/andP[]/negbTE -> _.
+have ppuhy : (p_y pp == pvert_y (point e) he) = false.
+  apply/negbTE; move: (ppuh).
+  rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
+  by rewrite (same_pvert_y vpphe samex).
+rewrite !(@in_cons [eqType of pt]).
+rewrite !pt_eqE ppuhy andbF orbF.
+move: ppae; rewrite lt_neqAle eq_sym=>/andP[] /negbTE -> _.
+by rewrite andbF.
+Qed.
+
+Lemma first_closing_side_char pp fc cc1 cc lcc lc le he :
+  open_cells_decomposition open (point e) = (fc, cc1 :: cc, lcc, lc, le, he) ->
+  in_safe_side_right pp (close_cell (point e) cc1) =
+   [&& p_x pp == p_x (point e), p_y pp < p_y (point e) & pp >>> le].
+Proof.
+move=> oe.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [/= leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+have cc1in : cc1 \in open by rewrite ocd !(mem_cat, inE) eqxx !orbT.
+have /andP [vlcc1 vhcc1] : valid_edge (low cc1) (point e) &&
+  valid_edge (high cc1) (point e) by apply: (allP sval).
+have := right_limit_close_cell vlcc1 vhcc1.
+rewrite /in_safe_side_right.
+move=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [-> -> _] := close_cell_preserve_3sides (point e) cc1.
+rewrite -leq.
+have eonhcc1 : (point e) === high cc1.
+  have := open_cells_decomposition_point_on cbtom adj 
+            (inside_box_between inbox_e) sval oe.
+  by move=> /(_ cc1 (mem_head _ _)).
+have vpph : valid_edge (high cc1) pp.
+  by rewrite (same_x_valid _ samex).
+have vpple : valid_edge le pp.
+  by rewrite (same_x_valid _ samex).
+rewrite (strict_under_pvert_y vpph) (same_pvert_y vpph samex).
+rewrite (on_pvert eonhcc1).
+have [ppue /= | ] := boolP (p_y pp < p_y (point e)); last by [].
+have [ppal/= | ] := boolP (pp >>> le); last by [].
+rewrite /right_pts/close_cell (pvertE vlcc1) (pvertE vhcc1) /=.
+rewrite !pt_eqE !eqxx /=.
+rewrite (on_pvert eonhcc1) eqxx.
+rewrite -leq; move: (pal).
+rewrite (under_pvert_y vle) -ltNge lt_neqAle=> /andP[] /negbTE -> _.
+have ppaly : (p_y pp == pvert_y (point e) le) = false.
+  apply/negbTE; move: (ppal).
+  rewrite (under_pvert_y vpple) -ltNge lt_neqAle eq_sym=> /andP[] + _.
+  by rewrite (same_pvert_y vpple samex).
+rewrite !(@in_cons [eqType of pt]) !pt_eqE ppaly andbF.
+move: ppue; rewrite lt_neqAle eq_sym=>/andP[] /negbTE -> _.
+by rewrite andbF.
+Qed.
+
+Lemma middle_closing_side_char pp fc cc1 cc lcc lc le he :
+  open_cells_decomposition open (point e) = (fc, cc1 :: cc, lcc, lc, le, he) ->
+  ~~ has (in_safe_side_right pp) [seq close_cell (point e) c | c <- cc].
+Proof.
+move=> oe.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+rewrite -all_predC; apply/allP=> c /mapP [c' cin cq] /=.
+have /andP[vlc' vhc']: valid_edge (low c') (point e) &&
+       valid_edge (high c') (point e).
+  by apply: (allP sval); rewrite ocd !(mem_cat, inE) cin !orbT.
+have := right_limit_close_cell vlc' vhc'.
+have allon := open_cells_decomposition_point_on cbtom adj 
+            (inside_box_between inbox_e) sval oe.
+have /allon eonh : c' \in cc1 :: cc by rewrite inE cin orbT.
+have eonl : point e === low c'.
+  have [s1 [s2 ccq]] := mem_seq_split cin.
+  have := adj; rewrite ocd ccq /= => /adjacent_catW[] _ /=.
+  rewrite /= cat_path=> /andP[] + _.
+  rewrite cat_path=> /andP[] _ /= /andP[] /eqP <- _.
+  by apply: allon; rewrite ccq -cat_cons mem_cat mem_last.
+rewrite /in_safe_side_right cq=> ->.
+have [-> -> _] := close_cell_preserve_3sides (point e) c'.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have vpph : valid_edge (high c') pp.
+  by rewrite (same_x_valid _ samex).
+have vppl : valid_edge (low c') pp.
+  by rewrite (same_x_valid _ samex).
+rewrite (strict_under_pvert_y vpph) (same_pvert_y vpph samex).
+rewrite (on_pvert eonh).
+rewrite (under_pvert_y vppl) (same_pvert_y vppl samex).
+rewrite (on_pvert eonl).
+by case : ltP; rewrite // le_eqVlt=> ->; rewrite orbT andbF.
+Qed.
+
+Lemma mem_no_dup_seq {A: eqType} (s : seq A) : no_dup_seq s =i s.
+Proof.
+elim: s => [ | a [ | b s] Ih]; first by [].
+  by [].
+rewrite -[no_dup_seq _]/(if a == b then no_dup_seq (b :: s) else
+                           a :: no_dup_seq (b :: s)).
+have [ab | anb] := (eqVneq a b).
+  by move=> c; rewrite Ih !inE ab; case: (c == b).
+by move=> c; rewrite 2!inE Ih.
+Qed.
+
+Lemma single_closing_side_char fc lcc lc le he pp :
+  open_cells_decomposition open (point e) = (fc, [::], lcc, lc, le, he) ->
+  in_safe_side_right pp (close_cell (point e) lcc) =
+  ([&& p_x pp == p_x (point e), pp >>> le & p_y pp < p_y (point e)] ||
+   [&& p_x pp == p_x (point e), pp <<< he & p_y (point e) < p_y pp]).
+Proof.
+move=> oe.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [/= leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+have /andP[vllcc vhlcc] : valid_edge (low lcc) (point e) &&
+   valid_edge (high lcc) (point e).
+  by apply: (allP sval); rewrite ocd /= !(mem_cat, inE) eqxx !orbT.
+have [ppe | ppne] := eqVneq (pp : pt) (point e).
+  rewrite ppe !lt_irreflexive !andbF.
+  apply /negbTE.
+  have einr := close_cell_in (conj vllcc vhlcc).
+  by rewrite /in_safe_side_right einr !andbF.
+have := right_limit_close_cell vllcc vhlcc.
+rewrite /in_safe_side_right.
+move=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [-> -> _] := close_cell_preserve_3sides (point e) lcc.
+rewrite -heq -leq.
+have puhy : p_y (point e) < pvert_y (point e) he.
+  by rewrite -(strict_under_pvert_y vhe).
+have paly :  pvert_y (point e) le < p_y (point e).
+  by rewrite ltNge -(under_pvert_y vle).
+rewrite /close_cell/right_pts -leq -heq (pvertE vle) (pvertE vhe).
+rewrite (@mem_no_dup_seq [eqType of pt]) !(@in_cons [eqType of pt]) (negbTE ppne) /=.
+have [vpple vpphe] : valid_edge le pp /\ valid_edge he pp.
+  by rewrite !(same_x_valid _ samex).
+have [pu | ] := ltrP (p_y pp) (p_y (point e)).
+  rewrite !pt_eqE /= andbT samex /=.
+  rewrite ltNge le_eqVlt pu orbT andbF orbF.
+  have ppuhe : pp <<< he.
+    rewrite strict_under_pvert_y // (same_pvert_y _ samex) //.
+    apply: (lt_trans pu).
+    by rewrite -strict_under_pvert_y.
+  rewrite (andbCA _ (pp >>> le)).
+  have [ppale /= | ] := boolP (pp >>> le); last by [].
+  have ppaly : (p_y pp == pvert_y (point e) le) = false.
+    apply/negbTE; move: (ppale).
+    rewrite (under_pvert_y vpple) -ltNge lt_neqAle eq_sym=> /andP[] + _.
+    by rewrite (same_pvert_y vpple samex).
+  have ppuhy : (p_y pp == pvert_y (point e) he) = false.
+    apply/negbTE; move: (ppuhe).
+    rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
+    by rewrite (same_pvert_y vpphe samex).
+  by rewrite ppaly ppuhy ppuhe.
+rewrite le_eqVlt => /orP[samey | /[dup] pa ->].
+   by case/negP: ppne; rewrite pt_eqE samex eq_sym samey.
+rewrite andbF andbT /=.
+have [ppuhe /= | ] := boolP (pp <<< he); last by [].
+
+rewrite !pt_eqE /= samex /=.
+have ppale : pp >>> le.
+  rewrite under_pvert_y // (same_pvert_y _ samex) // -ltNge.
+  apply: (lt_trans _ pa).
+  by rewrite ltNge -under_pvert_y.
+have ppaly : (p_y pp == pvert_y (point e) le) = false.
+  apply/negbTE; move: (ppale).
+  rewrite (under_pvert_y vpple) -ltNge lt_neqAle eq_sym=> /andP[] + _.
+  by rewrite (same_pvert_y vpple samex).
+have ppuhy : (p_y pp == pvert_y (point e) he) = false.
+  apply/negbTE; move: (ppuhe).
+  rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
+  by rewrite (same_pvert_y vpphe samex).
+by rewrite ppale ppuhy ppaly.
+Qed.
+
+Lemma sides_equiv fc cc lcc lc le he:
+  open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
+  forall p, has (in_safe_side_right p)
+              (rcons (closing_cells (point e) cc)
+                 (close_cell (point e) lcc)) ==
+       has (in_safe_side_left p)
+         (opening_cells (point e) (outgoing e) le he).
+Proof.
+move=> oe pp.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+have [pal puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+      (inside_box_between inbox_e) oe.
+have [ogq | ogq] := eqVneq (outgoing e) [::].
+  rewrite (single_opening_cell_side_char pp vle vhe pal puh ogq).
+  case ccq : cc => [ | cc1 cc'].  
+    move: (oe); rewrite ccq=> oe'.
+    by rewrite /= (single_closing_side_char pp oe') orbF.
+  move: (oe); rewrite ccq=> oe'.
+  rewrite /= has_rcons.
+  rewrite (first_closing_side_char pp oe').
+  rewrite (negbTE (middle_closing_side_char _ oe')) orbF.
+  rewrite (last_closing_side_char pp oe'); last by []. 
+  by rewrite (andbC (pp >>> le)) (andbC (pp <<< he)).
+rewrite /opening_cells; case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have oeq : opening_cells (point e) (outgoing e) le he = rcons nos lno.
+ by rewrite /opening_cells oca_eq.
+have := opening_cells_aux_absurd_case vle vhe ogq oute; rewrite oca_eq /=.
+case nosq : nos => [ | fno nos'] // _.
+move: oeq; rewrite nosq=> oeq.
+rewrite /=.
+rewrite (first_opening_cells_side_char pp ogq vle vhe pal oute oeq).
+rewrite [in X in _ == X]has_rcons.
+rewrite (last_opening_cells_side_char pp ogq vle vhe puh oute oeq).
+rewrite (negbTE (middle_opening_cells_side_char pp ogq vle vhe oute oeq)) orbF.
+case ccq : cc => [ | cc1 cc'].  
+    move: (oe); rewrite ccq=> oe'.
+    rewrite /= (single_closing_side_char pp oe') orbF.
+    by rewrite (andbC (_ >>> _)) (andbC (_ <<< _)).
+move: (oe); rewrite ccq=> oe'.
+rewrite /= has_rcons.  
+rewrite (first_closing_side_char pp oe').
+rewrite (negbTE (middle_closing_side_char _ oe')) orbF.
+by rewrite (last_closing_side_char pp oe'); last by []. 
+Qed.
+
+End step.
+
+End proof_environment.
+
+Notation open_cell_side_limit_ok :=
+  (@open_cell_side_limit_ok R).
+
+Lemma inside_box_left_ptsP bottom top p :
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  inside_box bottom top p -> left_limit (start_open_cell bottom top)  < p_x p.
+Proof.
+move=> sok /andP[] _ /andP[] /andP[] valb _ /andP[] valt _.
+rewrite leftmost_points_max //.
+by case : (lerP (p_x (left_pt bottom)) (p_x (left_pt top))).
+Qed.
+
+Lemma cell_edges_start bottom top :
+  cell_edges [::(start_open_cell bottom top)] = [:: bottom; top].
+Proof. by []. Qed.
+
+Record common_general_position_invariant bottom top edge_set s
+  (events : seq event) :=
+  { inv1 : inv1_seq bottom top events (state_open_seq s);
+   lstx_eq : lst_x _ _ s = left_limit (lst_open s);
+   high_lsto_eq : high (lst_open s) = lst_high _ _ s;
+   edges_sub : {subset all_edges (state_open_seq s) events <=
+                    bottom :: top :: edge_set};
+   closed_events : close_edges_from_events events;
+   out_events : {in events, forall e, out_left_event e};
+   inbox_events : all (inside_box bottom top)
+           [seq point x | x <- events];
+   lex_events : sorted (@lexPtEv _) events;
+   sides_ok : all open_cell_side_limit_ok (state_open_seq s);
+   general_pos :
+     all (fun ev => lst_x _ _ s < p_x (point ev)) events &&
+     sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) events;
+}.
+
+(* This lemma only provides a partial correctness statement in the case
+  where the events are never aligned vertically.  This condition is
+  expressed by the very first hypothesis.  TODO: it relies on the assumption
+  that the first open cell is well formed.  This basically means that the
+  two edges have a vertical overlap.  This statement should be probably
+  be made clearer in a different way.
+
+  TODO: one should probably also prove that the final sequence of open
+  cells, here named "open", should be reduced to only one element. *)
+Record disjoint_general_position_invariant (bottom top : edge)
+ (edge_set : seq edge)
+ (s : scan_state) (events : seq event) :=
+ { op_cl_dis :
+     {in state_open_seq s & state_closed_seq s,
+       disjoint_open_closed_cells R};
+   cl_dis : {in state_closed_seq s &, disjoint_closed_cells R};
+   common_inv_dis : common_general_position_invariant bottom top
+        edge_set s events;
+   pairwise_open : pairwise (@edge_below _)
+       (bottom :: [seq high c | c <- state_open_seq s]);
+   closed_at_left :
+       {in state_closed_seq s & events,
+          forall c e, right_limit c <= p_x (point e)};
+   }.
+
+Definition dummy_state :=
+  Bscan [::] dummy_cell [::] [::] dummy_cell dummy_edge 0.
+
+Definition initial_state bottom top (events : seq event) :=
+  match events with
+  | [::] => dummy_state
+  | ev :: future_events =>
+    let (nos, lno) :=
+      opening_cells_aux (point ev) (sort (@edge_below _) (outgoing ev))
+           bottom top in
+      Bscan nos lno [::] [::]
+         (close_cell (point ev) (start_open_cell bottom top))
+         top (p_x (point ev))
+  end.
+
+Lemma initial_intermediate bottom top s events :
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  sorted (@lexPtEv _) events ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  close_edges_from_events events ->
+  events != [::] ->
+  let op0 := (* close_cell (point (head (dummy_event _) events))  *)
+               (start_open_cell bottom top) in
+  all open_cell_side_limit_ok [:: op0] /\
+  cells_bottom_top bottom top [:: op0] /\
+  adjacent_cells [:: op0] /\
+  seq_valid [:: op0] (point (head dummy_event events)) /\
+  s_right_form [:: op0] /\
+  all (inside_box bottom top) [seq point e | e <- behead events] /\
+  close_edges_from_events (behead events) /\
+  {in behead events, forall e, out_left_event e} /\
+  close_alive_edges bottom top [:: op0] events  /\
+  valid_edge bottom (point (head dummy_event events)) /\
+  valid_edge top (point (head dummy_event events)) /\
+  open_cells_decomposition ([::] ++ [:: op0])
+        (point (head dummy_event events)) =
+       ([::], [::], op0, [::], low op0, high op0) /\
+  {in bottom :: top :: s &, no_crossing R} /\
+  {in all_edges [:: op0] events &, no_crossing R} /\
+  pairwise (@edge_below _) (bottom :: [seq high c | c <- [:: op0]]) /\
+  sorted (@lexPtEv _) (behead events).
+Proof.
+move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle.
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+case evsq : events => [ | ev future_events]; [by [] | move=> _ /=].
+set op0 := (start_open_cell bottom top).
+have op0sok : all open_cell_side_limit_ok ([::] ++ [::op0]).
+  by rewrite /= /op0 startok.
+have cbtom0 : cells_bottom_top bottom top [:: op0].
+  by rewrite /op0 /cells_bottom_top/cells_low_e_top/= !eqxx.
+have adj0: adjacent_cells [:: op0] by [].
+have sval0 : seq_valid [:: op0] (point ev).
+  move: evin; rewrite evsq /= => /andP[] /andP[] _ /andP[] ebot etop _.
+  have betW : forall a b c : R, a < b < c -> a <= b <= c.
+    by move=> a b c /andP[] h1 h2; rewrite !ltW.
+  by rewrite /= /valid_edge/generic_trajectories.valid_edge /= !betW.
+have rf0: s_right_form [:: op0] by rewrite /= boxwf.
+have inbox0 : all (inside_box bottom top) [seq point e | e <- future_events].
+  by move: evin; rewrite evsq map_cons /= => /andP[].
+have cle0 : close_edges_from_events future_events.
+  by move: cle; rewrite evsq /= => /andP[].
+have oute0 : {in future_events, forall e, out_left_event e}.
+  by move=> e ein; apply: out_evs; rewrite evsq inE ein orbT.
+have clae0 : close_alive_edges bottom top [:: op0] (ev :: future_events).
+  by rewrite /=/end_edge_ext !inE !eqxx !orbT.
+have noc0 : {in all_edges [:: op0] (ev :: future_events) &, no_crossing R}.
+  rewrite /=; move: nocs; apply sub_in2.
+  move=> x; rewrite -evsq !inE.
+  move=> /orP[ -> // | /orP[-> // | ]]; rewrite ?orbT //.
+  by move=> /evsub ->; rewrite !orbT.
+have [vb vt] : valid_edge bottom (point ev) /\ valid_edge top (point ev).
+  have /(allP sval0) : start_open_cell bottom top \in [:: op0].
+    by rewrite inE eqxx.
+  by rewrite /= => /andP[].
+have /andP[/andP[pal puh] _] : inside_box bottom top (point ev).
+   by apply: (@allP [eqType of pt] _ _ evin); rewrite evsq map_f// inE eqxx.
+have : open_cells_decomposition [:: op0] (point ev) =
+  ([::], [::], op0, [::], bottom, top).
+  apply: (open_cells_decomposition_single
+           (isT : adjacent_cells ([::] ++ [:: op0])) rf0 sval0 pal puh).
+have pw0 : pairwise (@edge_below _) (bottom :: [seq high c | c <- [::op0]]).
+  by rewrite /= !andbT /=.
+have lexev0 : sorted (@lexPtEv _) future_events.
+  by move: lexev; rewrite evsq=> /path_sorted.
+do 15 (split; first by []).
+by [].
+Qed.
+
+Lemma initial_common_general_position_invariant bottom top s events:
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  sorted (@lexPtEv _) events ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  close_edges_from_events events ->
+  events != [::] ->
+  common_general_position_invariant bottom top s
+    (initial_state bottom top events)
+    (* (head (dummy_event _) events) *) (behead events).
+Proof.
+move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
+have :=
+  initial_intermediate ltev boxwf startok nocs' evin lexev evsub out_evs cle
+    evsn0.
+case evsq : events evsn0 => [ | ev future_events]; [by [] | move=> _].
+move=> [op0sok [cbtom0 [adj0 /=
+           [sval0 [rf0 [inbox0 [cle0 [oute0 [clae0 [vb 
+             [vt [oe [nocs [noc0 [pw0 lexev0]]]]]]]]]]]]]]].
+have evins : ev \in events by rewrite evsq inE eqxx.
+set op0 := start_open_cell bottom top.
+case oca_eq:  (opening_cells_aux _ _ _ _) => [nos lno].
+set w := Bscan _ _ _ _ _ _ _.
+have [state1 ] : exists state1, state1 = w by exists w.
+rewrite /w => {w} st1q.
+set cl0 := lst_closed state1.
+set ops0 := [::] ++ [:: op0].
+have evsin0 : all (inside_box bottom top) [seq point ev | ev <- events].
+  exact: evin.
+have oute : out_left_event ev by apply: out_evs.
+have oute' : {in sort (@edge_below _) (outgoing ev), forall g,
+                  left_pt g == point ev}.
+  by move=> g; rewrite mem_sort; apply: oute.
+have edges_sub1 : {subset all_edges (rcons nos lno) 
+        future_events <= [:: bottom, top & s]}.
+  move=> g; rewrite mem_cat=> /orP[ | gfut ]; last first.
+    have /evsub {}gfut : g \in events_to_edges events.
+      by rewrite evsq events_to_edges_cons mem_cat gfut orbT.
+    by rewrite !inE gfut; rewrite !orbT.
+  have := opening_cells_subset vb vt oute.
+  rewrite /opening_cells oca_eq=> main.
+  rewrite mem_cat=> /orP[] /mapP [c /main + ->] => /andP[]; rewrite !inE.
+    move=> /orP[-> | +] _; first by rewrite ?orbT.
+    move=> {}main; apply/orP; right; apply/orP; right.
+    by apply/evsub/flattenP; exists (outgoing ev); rewrite // map_f.
+  move=> _ /orP[-> |]; first by rewrite ?orbT.
+  move=> {}main; apply/orP; right; apply/orP; right.
+  by apply/evsub/flattenP; exists (outgoing ev); rewrite // map_f.
+have pin : inside_box bottom top (point ev).
+  by apply: (@allP [eqType of pt] _ _ evin); rewrite evsq /= inE eqxx.
+have inbox_all_events0 :
+  all (inside_box bottom top) [seq point x | x <- (ev :: future_events)].
+  by move: evin; rewrite evsq.
+have evlexfut : path (@lexPtEv _) ev future_events.
+  by move: lexev; rewrite evsq.
+have rf0' : s_right_form ([::] ++ [:: start_open_cell bottom top]) by [].
+have cle0' : close_edges_from_events (ev :: future_events) by rewrite -evsq.
+have := invariant1_default_case
+          inbox_all_events0 oute rf0' cbtom0 adj0 sval0 cle0' clae0 noc0
+          evlexfut.
+rewrite oe oca_eq /=.
+move=> /[dup] inv1 -[] clae1 [] sval' [] adj1 [] cbtom1 rf1.
+have rl0 : {in [::], forall c : cell, right_limit c <= p_x (point ev)} by [].
+have cl0q : cl0 = close_cell (point ev) op0 by rewrite /cl0 st1q.
+rewrite -cats1 in edges_sub1 sval'.
+have lstx1op : lst_x _ _ state1 = left_limit (lst_open state1).
+  have := opening_cells_left oute vb vt; rewrite /opening_cells.
+  by rewrite oca_eq st1q => -> //=; rewrite mem_rcons inE eqxx.
+have sh1 : all (fun ev => lst_x _ _ state1 < p_x (point ev)) future_events &&
+          sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) future_events.
+  move: ltev; rewrite evsq /= path_sortedE /=; last first.
+    by move=> x y z; apply: lt_trans. 
+  by rewrite st1q.
+have he1q' : high (lst_open state1) = lst_high _ _ state1.
+  rewrite st1q /=.
+  by have := opening_cells_aux_high_last vb vt oute'; rewrite oca_eq.
+move: lstx1op he1q' sh1; rewrite st1q=> lstx1op he1q' sh1.
+have oks1 : all open_cell_side_limit_ok (nos ++ [:: lno]).
+  have := pin => /andP[] /andP[] /underWC pal puh _.
+  have := opening_cells_side_limit vb vt pal puh oute.
+  by rewrite /opening_cells oca_eq cats1.
+by constructor.
+Qed.
+
+Lemma initial_disjoint_general_position_invariant
+    bottom top s events:
+   sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  sorted (@lexPtEv _) events ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  close_edges_from_events events ->
+  events != [::] ->
+  disjoint_general_position_invariant bottom top s
+   (initial_state bottom top events)
+   (* (head (dummy_event _) events) *) (behead events).
+Proof.
+move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
+have := initial_common_general_position_invariant ltev boxwf startok
+  nocs' evin lexev evsub out_evs cle evsn0.
+have := initial_intermediate ltev boxwf startok nocs' evin lexev evsub
+   out_evs cle evsn0.
+move: evsn0; case evsq : events => [ | ev evs];[by [] | move=> _].
+lazy zeta; rewrite [head _ _]/= [behead _]/=.
+move=> -[] op0sok [cbtom0 [adj0 [sval0 [rf0 [inbox0 
+[cle0 [oute0 [clae0 [vb [vt [oe [nocs [noc0 [pw0 lexev0]]]]]]]]]]]]]].
+have evins : ev \in events by rewrite evsq inE eqxx.
+rewrite /initial_state /state_open_seq/state_closed_seq/= => Cinv.
+case oca_eq:  (opening_cells_aux _ _ _ _) Cinv => [nos lno] Cinv.
+move: (Cinv)=> -[]; rewrite /state_open_seq/state_closed_seq/=.
+move=> inv1 pxe hlno edges_sub1 cle1 oute1 inbox1 lexevs sok1 gen_pos.
+set op0 := start_open_cell bottom top.
+have op0_cl0_dis : {in [:: op0] & [::], disjoint_open_closed_cells R} by [].
+have inbox0' : all (inside_box bottom top) [seq point e | e <- ev :: evs].
+  by rewrite -evsq.
+have cl0_dis : {in [::] &, disjoint_closed_cells R} by [].
+have rl0 : {in [::], forall c : cell, right_limit c <= p_x (point ev)} by [].
+have := @step_keeps_disjoint_default bottom top ev [::]
+            op0 [::] evs inbox0' (out_evs _ evins) rf0 cbtom0 adj0
+            sval0 pw0 op0sok [::] op0_cl0_dis cl0_dis rl0.
+  rewrite oe oca_eq /= => -[] cl_dis1 op_cl_dis1.
+have pw1 : pairwise (@edge_below _)
+     (bottom:: [seq high c | c <- (nos ++ [:: lno ])]).
+  have rf0' : s_right_form ([::] ++ [:: op0]) by [].
+  have := step_keeps_pw_default inbox0' (out_evs _ evins) rf0' cbtom0 adj0
+    sval0 noc0 pw0.
+  by rewrite oe oca_eq.
+have rl_closed1 : {in [:: close_cell (point ev) op0] & evs,
+  forall c e, right_limit c <= p_x (point e)}.
+  have vho : valid_edge (high op0) (point ev) by []. 
+  have vlo : valid_edge (low op0) (point ev) by [].
+  have := right_limit_close_cell vlo vho=> rlcl0 c e.
+  rewrite inE=> /eqP ->.
+  move: lexev; rewrite evsq /= path_sortedE; last by apply: lexPtEv_trans.
+  move=> /andP[] + _=> /allP /[apply].
+  rewrite rlcl0=> /orP[]; first by move/ltW.
+  by move=> /andP[] /eqP -> _; apply: le_refl.
+by constructor.
+Qed.
+
+Lemma simple_step_common_general_position_invariant
+  bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  open_cells_decomposition (fop ++ lsto :: lop) (point ev) =
+    (fc, cc, lcc, lc, le, he) ->
+  common_general_position_invariant bottom top s
+     (Bscan fop lsto lop cls lstc lsthe lstx)
+     (ev :: evs) ->
+  common_general_position_invariant bottom top s
+     (simple_step fc cc lc lcc le he cls lstc ev)
+    evs.
+Proof.
+move=> boxwf nocs' inbox_s oe.
+move=> []; rewrite /state_open_seq/state_closed_seq/=.
+move=> inv lstxq lstheq sub_edges cle  out_es /[dup] inbox0.
+move=> /andP[] inbox_e inbox_es.
+move=> lexev oks /andP[] lstxlt ltev'.
+move: (inv)=> [] clae [] []; first by [].
+move=> sval [] adj [] cbtom rfo.
+have oute : out_left_event ev.
+  by apply: out_es; rewrite inE eqxx.
+have oute' : {in sort (@edge_below _) (outgoing ev),
+                   forall g, left_pt g == point ev}.
+  by move=> g; rewrite mem_sort; apply: oute.
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+have noco : {in all_edges (fop ++ lsto :: lop) (ev :: evs) &,
+                 no_crossing R}.
+ by  move=> g1 gt2 g1in g2in; apply: nocs; apply: sub_edges.
+rewrite /simple_step/generic_trajectories.simple_step.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have inv' : inv1_seq bottom top evs ((fc ++ nos) ++ lno :: lc).
+  have := invariant1_default_case inbox0 oute rfo cbtom adj sval cle clae
+            noco lexev.
+  by rewrite oe oca_eq.
+have := inv' =>  -[] clae' [] sval' [] adj' []cbtom' rfo'.
+have exi := exists_cell cbtom adj (inside_box_between inbox_e).
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+  decomposition_main_properties oe exi.
+have [{}pal {}puh vl vp nc]:=
+  decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+have /esym left_last : left_limit lno = p_x (point ev).
+  apply: (opening_cells_left oute vl vp).
+  by rewrite /opening_cells oca_eq mem_rcons inE eqxx.
+have heqo : high lno = he. 
+  by have := opening_cells_aux_high_last vl vp oute'; rewrite oca_eq.
+have sub_edges' : {subset all_edges ((fc ++ nos) ++ lno :: lc) evs <=
+                     [:: bottom, top & s]}.
+  have := step_keeps_subset_default inbox0 oute rfo cbtom adj sval.
+  rewrite oe oca_eq !catA /= /all_edges => main g.
+  rewrite mem_cat=> /orP[ | gin]; last first.
+    apply: sub_edges; rewrite mem_cat; apply/orP; right.
+    by rewrite events_to_edges_cons mem_cat gin orbT.
+  rewrite (cell_edges_sub_high cbtom' adj') inE=> /orP[/eqP -> | /main].
+    by rewrite inE eqxx.  
+  rewrite mem_cat=> /orP[] gin; apply: sub_edges; last first.
+    by rewrite mem_cat events_to_edges_cons orbC mem_cat gin.
+  by rewrite mem_cat mem_cat gin orbT.
+have cle' : close_edges_from_events evs by move: cle=> /andP[].
+have out_es' : {in evs, forall e, out_left_event e}.
+  by move=> e ein; apply: out_es; rewrite inE ein orbT.
+have lexev' : sorted (@lexPtEv _) evs by move: lexev=> /path_sorted.
+have oks' : all open_cell_side_limit_ok ((fc ++ nos) ++ lno :: lc).
+  have := step_keeps_open_side_limit_default inbox0 oute rfo
+    cbtom adj sval oks; rewrite oe oca_eq.
+  by [].
+have ltev1 : all (fun e => p_x (point ev) < p_x (point e)) evs &&
+         sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) evs.
+  move: ltev'; rewrite path_sortedE //.
+  by move=> x y z; apply: lt_trans.
+by constructor.
+Qed.
+
+Lemma simple_step_disjoint_general_position_invariant
+  bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  open_cells_decomposition (fop ++ lsto :: lop) (point ev) =
+    (fc, cc, lcc, lc, le, he) ->
+  disjoint_general_position_invariant bottom top s
+     (Bscan fop lsto lop cls lstc lsthe lstx)
+     (ev :: evs) ->
+  disjoint_general_position_invariant bottom top s
+     (simple_step fc cc lc lcc le he cls lstc ev)
+    evs.
+Proof.
+move=> boxwf nocs' inbox_s oe.
+move=> []; rewrite /state_open_seq/state_closed_seq/=.
+move=> oc_dis c_dis Cinv pw rl.
+have := Cinv=> -[]; rewrite /state_open_seq/state_closed_seq/=.
+move=> inv1 lstxq lstheq sub_edges cle out_es inbox_es lexev oks gen_pos.
+have := inv1 => -[] clae [] []; first by [].
+move=> sval []adj []cbtom rfo.
+rewrite /simple_step/generic_trajectories.simple_step.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+have Cinv' : common_general_position_invariant bottom top s
+         (Bscan (fc ++ nos) lno lc
+            (cls ++ lstc :: closing_cells (point ev) cc)
+            (close_cell (point ev) lcc) he (p_x (point ev))) evs.
+  have := simple_step_common_general_position_invariant boxwf nocs' inbox_s oe.
+  rewrite /simple_step/generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  by rewrite oca_eq=> /(_ _ _ lsthe lstx); apply.
+have cl_at_left' : {in rcons cls lstc,
+        forall c, right_limit c <= p_x (point ev)}.
+  by move=> c cin; apply: rl; rewrite // inE eqxx.
+have oute : out_left_event ev by apply: out_es; rewrite inE eqxx.
+have := step_keeps_disjoint_default inbox_es oute rfo
+         cbtom adj sval pw oks oc_dis c_dis cl_at_left'.
+rewrite oe oca_eq /= !cat_rcons -!cats1 /= => disjointness.
+have op_cl_dis':
+  {in (fc ++ nos) ++ lno :: lc & rcons (cls ++ lstc ::
+           closing_cells (point ev) cc) (close_cell (point ev) lcc),
+         disjoint_open_closed_cells _}.
+   move=> c1 c2; rewrite -!(cats1, catA)=> c1in c2in.
+   by apply: (proj2 (disjointness)).
+have cl_dis : {in  rcons (cls ++ lstc :: closing_cells (point ev) cc)
+                 (close_cell (point ev) lcc) &, disjoint_closed_cells R}.
+  by rewrite -!(cats1, catA); apply: (proj1 disjointness).
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+have noc : {in all_edges (fop ++ lsto :: lop) (ev :: evs) &,
+                 no_crossing R}.
+  by move=> g1 gt2 g1in g2in; apply: nocs; apply: sub_edges.
+have pwo' : pairwise (@edge_below _)
+           (bottom :: [seq high c | c <- (fc ++ nos) ++ lno :: lc]).
+have := step_keeps_pw_default inbox_es oute rfo cbtom adj sval
+      noc pw.
+  by rewrite oe oca_eq -catA.
+have right_limit_closed' :
+  {in  rcons(cls ++ 
+          lstc :: closing_cells (point ev) cc) (close_cell (point ev) lcc) &
+     evs, forall c e, right_limit c <= p_x (point e)}.
+  have:= step_keeps_right_limit_closed_default inbox_es cbtom adj
+    sval lexev cl_at_left'.
+  by rewrite oe oca_eq /=.
+by constructor.
+Qed.
+
+Definition start :=
+  start R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1 edge
+  (@unsafe_Bedge _) (@left_pt _) (@right_pt _).
+
+Lemma start_eq_initial (bottom top : edge) (ev : event) :
+  start ev bottom top = initial_state bottom top [:: ev].
+Proof. by []. Qed.
+
+Definition complete_last_open : edge -> edge -> cell -> cell :=
+  complete_last_open
+    R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) edge
+    (@left_pt _) (@right_pt _).
+
+Lemma map_eq [A B : Type] (f : A -> B)  l :
+   List.map f l = [seq f x | x <- l].
+Proof. by []. Qed.
+
+Definition main_process bottom top evs :=
+  match evs with
+  | ev :: evs => scan evs (initial_state bottom top (ev :: evs))
+  | [::] => ([:: start_open_cell bottom top], [::])
+  end.
+
+Lemma complete_process_eq bottom top ev evs :
+  complete_process  R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1 edge
+  (@unsafe_Bedge _) (@left_pt _) (@right_pt _) (ev :: evs) bottom top =
+  match scan evs (initial_state bottom top (ev :: evs)) with
+   (a, b) => [seq complete_last_open bottom top c | c <- a] ++ b
+  end.
+Proof.  by []. Qed.
+
+
+Lemma complete_disjoint_general_position bottom top s closed open evs :
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) evs ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in one that is easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  all (inside_box bottom top) [seq point e | e <- evs] ->
+  sorted (@lexPtEv _) evs ->
+  {subset flatten [seq outgoing e | e <- evs] <= s} ->
+  {in evs, forall ev, out_left_event ev} ->
+  close_edges_from_events evs ->
+  main_process bottom top evs = (open, closed) ->
+  {in closed &, disjoint_closed_cells R} /\
+  {in open & closed, disjoint_open_closed_cells R}.
+Proof.
+move=> ltev boxwf startok nocs' inbox_s evin lexev evsub out_evs cle.
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+rewrite /main_process/scan.
+case evsq : evs => [ | ev future_events].
+  move=> [] <- <-; split; last by [].
+  by move=> c1 c2; rewrite in_nil.
+have evsn0 : evs != [::] by rewrite evsq.
+have := initial_disjoint_general_position_invariant ltev boxwf startok nocs'
+  evin lexev evsub out_evs cle evsn0.
+rewrite /initial_state evsq.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos1 lno1] /=.
+elim: (future_events) {oca_eq evsq} (Bscan _ _ _ _ _ _ _)=> [ | ev' fut' Ih].
+  move=> state_f /=; case: state_f=> [] f m l cls lstc lsthe lstx.
+  move=> /[swap] -[] <- <-; case; rewrite /state_open_seq /state_closed_seq /=.
+  move=> dis_op_cl dis_cl *; split; move=> c1 c2 c1in c2in.
+    by apply: dis_cl; rewrite // mem_rcons.
+  by apply: dis_op_cl; rewrite // mem_rcons.
+move=> {evs ltev evin lexev evsub out_evs cle evsn0}.
+move=> [fop lsto lop cls lstc lsthe lstx].
+case; set ops' := (state_open_seq _); set (cls' := state_closed_seq _).
+rewrite /=.
+move=> dis_open_closed dis_cl /[dup] Cinv [] inv1 lstxq lstheq sub_edges.
+move=> /[dup] cle /andP[cl_e_fut' cle'] out_fut'.
+move=> /[dup]  inbox_all_events' /andP[inbox_e inbox_all_events] lexevs oks.
+move=> /andP[] /andP[] lstxlte lstx_fut' ltfut' edges_pairwise cl_at_left.
+move: (inv1)=> [] clae [] pre_sval [] adj [] cbtom rfo.
+have sval : seq_valid (fop ++ lsto :: lop) (point ev') by case: pre_sval.
+
+rewrite /=/simple_step; case: ifP=> [_ | ]; last first.
+  move=> /negbFE; rewrite /same_x eq_sym=> /eqP abs; suff: False by [].
+  by move : lstxlte; rewrite abs lt_irreflexive.
+rewrite -/(open_cells_decomposition _ _).
+rewrite /generic_trajectories.simple_step.
+case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+apply: Ih.
+have :=
+  simple_step_disjoint_general_position_invariant boxwf nocs' inbox_s oe.
+  rewrite /simple_step/generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  rewrite oca_eq=> /(_ _ _ lsthe lstx).
+by apply.
+Qed.
+
+Record edge_covered_general_position_invariant (bottom top : edge)
+ (edge_set : seq edge) (processed_set : seq event)
+ (s : scan_state) (events : seq event) :=
+ { edge_covered_ec : {in processed_set, forall e,
+       {in outgoing e, forall g,
+       edge_covered g (state_open_seq s) (state_closed_seq s)}};
+   processed_covered : {in processed_set, forall e,
+       exists2 c, c \in (state_closed_seq s) &
+           point e \in (right_pts c : seq pt) /\ point e >>> low c}  ;
+   common_inv_ec : common_general_position_invariant bottom top edge_set
+     s events;
+   non_in_ec : 
+      {in edge_set & events, forall g e, non_inner g (point e)};
+   uniq_ec : {in events, forall e, uniq (outgoing e)};
+   inj_high : {in state_open_seq s &, injective high};
+   bot_left_cells : 
+       {in state_open_seq s & events, 
+          forall c e, lexPt (bottom_left_corner c) (point e)};
+   }.
+
+Lemma in_cell_edges_has_cell (s : seq cell) (g : edge) :
+   (g \in cell_edges s) = has (fun c => (g == low c) || (g == high c)) s.
+Proof.
+by elim: s => [ | c0 s Ih] //=; rewrite cell_edges_cons !inE !orbA Ih.
+Qed.
+
+Lemma bottom_left_start bottom top p : 
+  inside_box bottom top p ->
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  bottom_left_cells_lex [:: start_open_cell bottom top] p.
+Proof.
+move=> inbox_p startok c; rewrite inE => /eqP ->.
+have := leftmost_points_max startok => llq.
+move: (startok); rewrite /open_cell_side_limit_ok=> /andP[] ln0.
+move=> /andP[] samex _.
+rewrite /bottom_left_corner.
+have /eqP := (allP samex (last dummy_pt (left_pts (start_open_cell bottom top)))
+            (last_in_not_nil _ ln0)).
+rewrite llq.
+rewrite /lexPt=> ->.
+move: inbox_p=> /andP[] _ /andP[] /andP[] + _ /andP[] + _.
+case: (lerP (p_x (left_pt bottom)) (p_x (left_pt top))).
+  by move=> _ _ ->.
+by move=> _ ->.
+Qed.
+
+Lemma initial_edge_covering_general_position
+  bottom top s events:
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  sorted (@lexPtEv _) events ->
+   bottom <| top ->
+  close_edges_from_events events ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall g1 g2, inter_at_ext g1 g2} ->
+  {in s & events, forall g e, non_inner g (point e)} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  {in events, forall ev, uniq (outgoing ev)} ->
+  events != [::] ->
+  edge_covered_general_position_invariant bottom top s
+   [:: (head dummy_event events)]
+   (initial_state bottom top events) (behead events).
+Proof.
+move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es 
+  uniq_out_es evsn0.
+rewrite /initial_state.
+have := initial_intermediate gen_pos wf startok nocs' inbox_es lexev sub_es
+  out_es cle evsn0.
+have := initial_common_general_position_invariant gen_pos wf startok nocs'
+  inbox_es lexev sub_es out_es cle evsn0.
+case evsq : events evsn0 => [ // | e evs] _.
+case oca_eq: (opening_cells_aux _ _ _ _) => [nos lno].
+lazy zeta; rewrite [head _ _]/= [behead _]/=.
+have oute : out_left_event e by apply: out_es; rewrite evsq inE eqxx.
+move=> Cinv [] ok0 []cbtom0 []adj0 []sval0 []rf0 []inbox_es0 []cle1
+         []out_es1 []clae0 []vb []vt []oe0 []nocs []noc0 []pw0 lexevs.
+have inbox_e : inside_box bottom top (point e).
+  by apply/(@allP [eqType of pt] _ _ inbox_es)/map_f; rewrite evsq inE eqxx.
+have /andP[eab ebt] : (point e >>> bottom) && (point e <<< top).
+  by move: inbox_e=> /andP[].
+have cle0 : close_edges_from_events (e :: evs) by rewrite -evsq.
+move: inbox_es; rewrite evsq=> inbox_es.
+move: Cinv; rewrite/initial_state oca_eq/state_open_seq/state_closed_seq/=.
+move=> /[dup] Cinv; rewrite /state_open_seq/state_closed_seq /=.
+move=> -[]; rewrite /state_open_seq/state_closed_seq /=.
+move=> inv1 px1 lstheq1 sub1 _ _ _ _ oks1 lexpt1.
+have [clae1 [pre_sval [adj1 [cbtom1 rf1]]]] := inv1.
+set op0 := start_open_cell bottom top.
+have inj_high0 : {in [:: start_open_cell bottom top] &, injective high}.
+  by move=> g1 g2; rewrite !inE=> /eqP -> /eqP ->.
+have uniq1 : {in evs, forall e, uniq (outgoing e)}.
+  by move=> ev evin; apply: uniq_out_es; rewrite evsq inE evin orbT.
+have rf0' : s_right_form ([::] ++ [:: op0]) by [].
+have  btm_left_lex0 : 
+  bottom_left_cells_lex [:: start_open_cell bottom top] (point e).
+  by apply: bottom_left_start inbox_e startok.
+have inj_high1 : {in nos ++ [:: lno] &, injective high}.
+  have uniq_e : uniq (outgoing e) by apply: uniq_out_es; rewrite evsq inE eqxx.
+  have := step_keeps_injective_high_default inbox_es oute rf0' cbtom0
+    adj0 sval0 ok0 uniq_e inj_high0 btm_left_lex0.
+  by rewrite oe0 oca_eq.
+have n_inner0 : {in [:: start_open_cell bottom top],
+           forall c, non_inner (high c) (point e)}.
+  move=> c; rewrite inE /non_inner=> /eqP -> /onAbove.
+  by move: inbox_e=> /andP[] /andP[] _ ->.
+have n_inner1 : {in s & evs, forall g e, non_inner g (point e)}.
+  by move=> g ev gin evin; apply: n_inner; rewrite // evsq inE evin orbT.
+have cov1 : {in [:: e], forall e',
+    {in outgoing e', forall g, (edge_covered g (nos ++ [:: lno])
+            [:: close_cell (point e) op0])}}.
+  move=> e'; rewrite inE => /eqP -> {e'}.
+  have := step_keeps_edge_covering_default inbox_es oute rf0' cbtom0 adj0 sval0
+           ok0 inj_high0 btm_left_lex0 n_inner0 oe0 oca_eq=> /=.
+  move=> main g gin.
+  by apply: (main [::]); right.
+have btm_left_lex1 : {in nos ++ [:: lno] & evs,
+          forall c e0, lexPt (bottom_left_corner c) (point e0)}.
+  move=> c ev cin evin.
+  have eev : lexPtEv e ev.
+    move: lexev; rewrite evsq /= path_sortedE; last by apply: lexPtEv_trans.
+    by move=> /andP [] /allP + _; apply.
+  have := step_keeps_btom_left_corners_default inbox_es oute rf0' cbtom0
+    adj0 sval0 noc0 btm_left_lex0; rewrite oe0 oca_eq=> /(_ _ eev).
+  by apply.
+rewrite /state_open_seq/state_closed_seq/=.
+have cov_p1 : {in [:: e], forall e',
+  exists2 c, c \in [:: close_cell (point e) op0] &
+  point e' \in (right_pts c : seq pt)/\ point e' >>> low c}.
+  move=> e'; rewrite inE => /eqP -> {e'}.
+  exists (close_cell (point e) op0); first by rewrite mem_head.
+  split.
+    by exact: (@close_cell_in _ op0 (conj vb vt)).
+  by have [-> _ _] := close_cell_preserve_3sides (point e) op0.
+by constructor.
+Qed.
+
+Lemma edge_covered_sub (g : edge) op1 op2 cl1 cl2 :
+  op1 =i op2 -> cl1 =i cl2 ->
+  edge_covered g op1 cl1 -> edge_covered g op2 cl2.
+Proof.
+move=> eqop eqcl [[opc [cls [P1 [P2 [P3 [P4 P5]]]]]] | ].
+  left; exists opc, cls.
+  split;[ |split;[by [] | split;[by [] | split;[ | by []]]]] .
+    by move=> c; rewrite -eqcl; apply: P1.
+  by rewrite -eqop.
+move=> [pcc [P1 [P2 [P3 [P4 [P5 P6]]]]]].
+right; exists pcc; split;[by [] | split;[ | by []]].
+by move=> c; rewrite -eqcl; apply: P2.
+Qed.
+
+Lemma inside_box_non_inner bottom top (p : pt) :
+  inside_box bottom top p -> non_inner bottom p /\ non_inner top p.
+Proof.
+move=> /andP[] /andP[] absbot abstop _; split.
+  move=> /[dup] /andP[] _ vb; move: absbot; rewrite under_onVstrict // negb_or.
+  by move=> /[swap] ->.
+move=> /[dup] /andP[] _ vt; move: abstop; rewrite strict_nonAunder //.
+by move=> /[swap] ->.
+Qed.
+
+Lemma simple_step_edge_covered_general_position
+  bottom top s cov_set fop lsto lop fc cc lcc lc le he cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  open_cells_decomposition (fop ++ lsto :: lop) (point ev) =
+    (fc, cc, lcc, lc, le, he) ->
+  edge_covered_general_position_invariant bottom top s
+   cov_set (Bscan fop lsto lop cls lstc lsthe lstx)
+   (ev :: evs) ->
+  edge_covered_general_position_invariant bottom top s
+    (rcons cov_set ev) (simple_step fc cc lc lcc le he cls lstc ev)
+    evs.
+Proof.
+move=> boxwf nocs' inbox_s.
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+set st := Bscan _ _ _ _ _ _ _.
+move=> oe.
+move=> [] covered p_covered /[dup] Cinv [] /[dup] inv_s [] clae.
+move=> - [] []; first by [].
+rewrite /state_open_seq/state_closed_seq /= => sval [] adj [] cbtom rfo.
+move=> lstxq lstheq sub_edges cle out_es.
+move=> /[dup] inbox0 /andP[] inbox_e inbox_es lexev.
+move=> oks /andP[] lstxlt pathlt n_inner uniq_evs inj_high btm_left_lex.
+have out_e : out_left_event ev by apply: out_es; rewrite inE eqxx.
+have noc : {in all_edges (state_open_seq st) (ev :: evs) &, no_crossing R}.
+  by move=> g1 g2 g1in g2in; apply: nocs; apply: sub_edges.
+(* TODO: this should not be needed, if we had enough theorems about
+  simple_step. *)
+have lstxneq :  p_x (point ev) != lstx.
+  by move: lstxlt; rewrite lt_neqAle eq_sym=> /andP[] /andP[].
+case oca_eq : 
+  (opening_cells_aux (point ev) (sort (@edge_below _) (outgoing ev)) le he) =>
+      [nos lno].  
+have Cinv' :=
+  simple_step_common_general_position_invariant boxwf nocs' inbox_s oe Cinv.
+have btm_left_lex_e : {in (state_open_seq st), forall c,
+                         lexPt (bottom_left_corner c) (point ev)}.
+  by move=> c cin; apply: btm_left_lex; rewrite // inE eqxx.
+have n_inner2 : {in state_open_seq st,
+         forall c, non_inner (high c) (point ev)}.
+  move=> c cin.
+  have /sub_edges : high c \in all_edges (state_open_seq st) (ev :: evs).
+    by rewrite 2!mem_cat map_f ?orbT.
+  have /inside_box_non_inner [nib nit] : inside_box bottom top (point ev).
+    by move: inbox0 => /andP[].
+  rewrite !inE => /orP[/eqP -> | /orP [/eqP -> | hcin ]] //.
+  by apply: n_inner; rewrite // inE eqxx.
+have cov' : {in rcons cov_set ev,forall e', 
+  {in outgoing e', forall g, edge_covered g (state_open_seq 
+                              (simple_step fc cc lc lcc le he cls lstc ev))
+                  (state_closed_seq
+                     (simple_step fc cc lc lcc le he cls lstc ev))}}.
+  have main:= step_keeps_edge_covering_default
+    inbox0 out_e rfo cbtom adj sval oks inj_high btm_left_lex_e n_inner2
+         oe oca_eq.
+  have := main (state_closed_seq st) => {}main.
+  move=> e' e'in g gin.
+  have /main : edge_covered g (fop ++ lsto :: lop) (state_closed_seq st) \/
+         g \in outgoing ev.
+    move: e'in; rewrite -cats1 mem_cat=> /orP[/covered|]; last first.
+      by move: gin=> /[swap]; rewrite inE=> /eqP ->; right.
+    by move=> /(_ _ gin); left.
+  rewrite /state_open_seq /state_closed_seq /=.
+  apply: edge_covered_sub.
+    rewrite /simple_step/generic_trajectories.simple_step.
+    rewrite -/(opening_cells_aux _ _ _ _).
+    by rewrite oca_eq /= -catA.
+  rewrite /simple_step/generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux _ _ _ _).
+  by rewrite oca_eq /= !cat_rcons -!cats1 -!catA.
+have n_inner' : {in s & evs, forall g e, non_inner g (point e)}.
+  by move=> g e gin ein; apply: n_inner; rewrite // inE ein orbT.
+have uniq' : {in evs, forall e, uniq (outgoing e)}.
+  by move=> g gin; apply: uniq_evs; rewrite inE gin orbT.
+have uniq_ev : uniq (outgoing ev) by apply: uniq_evs; rewrite inE eqxx.
+have inj_high' : 
+  {in state_open_seq (simple_step fc cc lc lcc le he cls lstc ev) &,
+     injective high}.
+  have := step_keeps_injective_high_default inbox0 out_e rfo cbtom adj sval
+     oks uniq_ev inj_high btm_left_lex_e.
+  rewrite /simple_step/generic_trajectories.simple_step.
+  rewrite -/(open_cells_decomposition _ _).
+  rewrite -/(opening_cells_aux _ _ _ _).
+  by rewrite oe oca_eq /state_open_seq /= -catA.
+have btm_left_lex' :
+  {in state_open_seq (simple_step fc cc lc lcc le he cls lstc ev) & evs,
+     forall c e, lexPt (bottom_left_corner c) (point e)}.
+  have := step_keeps_btom_left_corners_default inbox0 out_e rfo cbtom adj
+     sval noc btm_left_lex_e.
+  rewrite /simple_step/= /= oe oca_eq /= /state_open_seq /=.
+  rewrite catA=> main.
+  move=> c e cin ein; apply: main=> //=.
+    move: lexev; rewrite path_sortedE; last by apply: lexPtEv_trans.  
+    by move=> /andP[] /allP /(_ e ein).
+  move: cin; rewrite /generic_trajectories.simple_step.
+  by rewrite -/(opening_cells_aux _ _ _ _) oca_eq.
+have p_cov' : {in rcons cov_set ev, forall e, exists2 c,
+   c \in state_closed_seq (simple_step fc cc lc lcc le he cls lstc ev) &
+   point e \in (right_pts c : seq pt) /\ point e >>> low c}.
+  have exi := exists_cell cbtom adj (inside_box_between inbox_e).
+  have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+    decomposition_main_properties oe exi.
+  have [{}pal {}puh vle vhe nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+  move=> e; rewrite mem_rcons inE=> /orP[]; last first.
+    move=> /p_covered [] c cin pin.
+    rewrite /state_closed_seq/simple_step/generic_trajectories.simple_step.
+    rewrite -/(opening_cells_aux _ _ _ _).
+    rewrite oca_eq /=.
+    exists c; last by [].
+    by rewrite -cats1 /= appE -(cat_rcons lstc) !mem_cat cin.
+  move=> /eqP -> {e}.
+  exists (close_cell (point ev) (head lcc cc)).
+    rewrite /state_closed_seq /simple_step/generic_trajectories.simple_step.
+    rewrite -/(opening_cells_aux _ _ _ _).
+    rewrite oca_eq /= -cats1 -catA /=.
+    rewrite -cat_rcons mem_cat; apply/orP; right.
+    by case: (cc) => [ | ? ?]; rewrite /= mem_head.
+  have hdin : head lcc cc \in fop ++ lsto :: lop.
+    rewrite ocd mem_cat; apply/orP; right.
+    by case: (cc)=> [ | ? ?]; rewrite /= mem_head.
+  split.
+    by apply/close_cell_in/andP/(allP sval).
+  have [-> _ _] := close_cell_preserve_3sides (point ev) (head lcc cc).
+  by rewrite -leq.
+by constructor.
+Qed.
+
+Lemma start_edge_covered_general_position bottom top s closed open evs :
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) evs ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in one that is easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  all (inside_box bottom top) [seq point e | e <- evs] ->
+  sorted (@lexPtEv _) evs ->
+  {subset events_to_edges evs <= s} ->
+  {in evs, forall ev, out_left_event ev} ->
+  close_edges_from_events evs ->
+  {in s & evs, forall g e, non_inner g (point e)} ->
+  {in evs, forall e, uniq (outgoing e)} ->
+  main_process bottom top evs = (open, closed) ->
+  {in events_to_edges evs, forall g, edge_covered g open closed} /\
+  {in evs, forall e, exists2 c, c \in closed & 
+      point e \in (right_pts c : seq pt) /\ point e >>> low c}.
+Proof.
+move=> ltev boxwf startok nocs' inbox_s evin lexev evsub out_evs cle
+  n_inner uniq_edges.
+(*
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+*)
+rewrite /start.
+case evsq : evs => [ | ev future_events]; first by split; move=> r_eq ?.
+have evsn0 : evs != [::] by rewrite evsq.
+have := initial_edge_covering_general_position ltev lexev boxwf cle
+  startok nocs' n_inner evin evsub out_evs uniq_edges evsn0.
+rewrite /initial_state evsq /=.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+set istate := Bscan _ _ _ _ _ _ _.
+move=> istateP req.
+suff main : forall events op cl st cov_set, 
+  edge_covered_general_position_invariant bottom top s cov_set st events ->
+  scan events st = (op, cl) ->
+  ({in events_to_edges (cov_set ++ events), forall g, edge_covered g op cl} /\
+  {in cov_set ++ events, forall e, exists2 c, c \in cl &
+    point e \in (right_pts c : seq pt) /\ point e >>> low c}).
+  by move: req; apply: (main _ _ _ _ [:: ev]).
+  move=> {req istateP istate oca_eq lno nos evsn0 evsq future_events ev}.
+  move=> {uniq_edges n_inner out_evs evsub lexev evin startok ltev}.
+  move=> {cle closed open evs}.
+  elim=> [ | ev evs Ih] op cl st cov_set.
+  case: st => fop lsto lop cls lstc lsthe lstx /=.
+  move=> []; rewrite /state_open_seq/state_closed_seq /= => + p_main.
+  move=> main _ _ _ _ _ [] <- <-; rewrite cats0; split.
+    move=> g=> /flatten_mapP[e' /main /[apply]].
+    apply: edge_covered_sub; first by [].
+    by move=> c; rewrite mem_rcons.
+  move=> e=> /p_main [c2 c2in pin2]; exists c2=> //.
+  by move: c2in; rewrite mem_rcons.
+move=> inv0; rewrite -cat_rcons.
+apply: Ih.
+case stq : st => [fop lsto lop cls lstc lsthe lstx].
+rewrite /step/generic_trajectories.step.
+have /andP[/andP[+ _] _] := general_pos (common_inv_ec inv0).
+rewrite lt_neqAle eq_sym => /andP[] lstxneq _.
+rewrite stq /= in lstxneq; rewrite lstxneq.
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+move: (inv0); rewrite stq=> inv1.
+by have := simple_step_edge_covered_general_position boxwf nocs'
+    inbox_s oe inv1.
+Qed.
+
+Record safe_side_general_position_invariant (bottom top : edge)
+ (edge_set : seq edge) (processed_set : seq event)
+ (s : scan_state) (events : seq event) :=
+ { disjoint_ss :
+     disjoint_general_position_invariant bottom top edge_set s events;
+   covered_ss :
+     edge_covered_general_position_invariant bottom top edge_set
+       processed_set s events;
+    left_proc : {in processed_set & events, forall e1 e2,
+                     p_x (point e1) < p_x (point e2)};
+    rf_closed : {in state_closed_seq s, forall c, low c <| high c};
+    diff_edges :
+       {in state_open_seq s ++ state_closed_seq s, forall c, low c != high c};
+    sub_closed :
+      {subset cell_edges (state_closed_seq s) <= bottom :: top :: edge_set};
+   (* TODO : move this to the common invariant. *)
+   left_o_lt :
+        {in state_open_seq s & events, 
+          forall c e, left_limit c < p_x (point e)};
+   left_o_b :
+        {in state_open_seq s, forall c, left_limit c < 
+              min (p_x (right_pt bottom)) (p_x (right_pt top))};
+   closed_lt : 
+        {in state_closed_seq s, forall c, left_limit c < right_limit c};
+   closed_ok :
+        all (@closed_cell_side_limit_ok R) (state_closed_seq s);
+   (* TODO : move this to the disjoint invariant. *)
+   cl_at_left_ss :
+     {in state_closed_seq s & events, 
+        forall c e, right_limit c < p_x (point e)};
+   safe_side_closed_edges :
+     {in events_to_edges processed_set & state_closed_seq s, forall g c p,
+         in_safe_side_left p c || in_safe_side_right p c -> ~ p === g};
+   safe_side_open_edges :
+     {in events_to_edges processed_set & state_open_seq s, forall g c p,
+         in_safe_side_left p c -> ~p === g};
+   safe_side_closed_points :
+     {in processed_set & state_closed_seq s, forall e c p,
+         in_safe_side_left p c || in_safe_side_right p c -> 
+         p != point e :> pt};
+   safe_side_open_points :
+     {in processed_set & state_open_seq s, forall e c p,
+         in_safe_side_left p c ->
+         p != point e :> pt};
+}.
+
+Lemma events_to_edges_rcons evs (e : event) :
+  events_to_edges (rcons evs e) = events_to_edges evs ++ outgoing e.
+Proof. by rewrite /events_to_edges /= map_rcons flatten_rcons. Qed.
+
+Lemma valid_open_limit (c : cell) p  :
+  valid_edge (low c) p -> valid_edge (high c) p -> p_x p <= open_limit c.
+Proof.
+move=> /andP[] _ lp /andP[] _ hp; rewrite /open_limit.
+by have [A | B] := lerP (p_x (right_pt (low c))) (p_x (right_pt (high c))).
+Qed.
+
+Lemma on_edge_inside_box (bottom top g : edge) p :
+  inside_box bottom top (left_pt g) ->
+  inside_box bottom top (right_pt g) ->
+  p === g ->
+  inside_box bottom top p.
+Proof.
+move=> inl inr pon.
+rewrite /inside_box.
+have -> : p >>> bottom.
+  have la : left_pt g >>> bottom by move: inl=>/andP[] /andP[].
+  have ra : right_pt g >>> bottom by move: inr=>/andP[] /andP[].
+  by have := point_on_edge_above_strict pon la ra.
+have -> : p <<< top.
+  have lu : left_pt g <<< top by move: inl=>/andP[] /andP[].
+  have ru : right_pt g <<< top by move: inr=>/andP[] /andP[].
+  by have := point_on_edge_under_strict pon lu ru.
+move: pon => /andP[] _ /andP[] lp pr.
+move: inl => /andP[] _ /andP[] /andP[] bl _ /andP[] tl _.
+move: inr => /andP[] _ /andP[] /andP[] _ rb /andP[] _ rt.
+rewrite (lt_le_trans bl lp) (lt_le_trans tl lp).
+by rewrite (le_lt_trans pr rb) (le_lt_trans pr rt).
+Qed.
+
+Lemma inside_box_lt_min_right (p : pt) bottom top :
+  inside_box bottom top p ->
+  p_x p < min (p_x (right_pt bottom)) (p_x (right_pt top)).
+Proof.
+move=> /andP[] _ /andP[] /andP[] _ + /andP[] _.
+by case : (ltrP (p_x (right_pt bottom)) (p_x (right_pt top))).
+Qed.
+
+Lemma initial_safe_side_general_position bottom top s events:
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  sorted (@lexPtEv _) events ->
+   bottom <| top ->
+  close_edges_from_events events ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall g1 g2, inter_at_ext g1 g2} ->
+  {in s & events, forall g e, non_inner g (point e)} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  {in events, forall ev, uniq (outgoing ev)} ->
+  events != [::] ->
+  safe_side_general_position_invariant bottom top s
+    [::(head dummy_event events)]
+   (initial_state bottom top events) (behead events).
+Proof.
+move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es 
+  uniq_out_es evsn0.
+have := initial_intermediate gen_pos wf startok nocs' inbox_es lexev sub_es
+  out_es cle evsn0.
+have := initial_disjoint_general_position_invariant gen_pos wf startok
+  nocs' inbox_es lexev sub_es out_es cle evsn0.
+have := initial_edge_covering_general_position gen_pos lexev wf cle
+  startok nocs' n_inner inbox_es sub_es out_es uniq_out_es evsn0.
+case evsq: events evsn0=> [ | ev evs]; [by [] | move=> evsn0]. 
+rewrite /initial_state.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+move=> e_inv d_inv.
+move=> []; set op0 := start_open_cell bottom top.
+rewrite [head _ _]/= [behead _]/=.
+move=> ok0 [] btom0 [] adj0 [] sval0 [] rf0 [] inbox_es0 [] cle0 [] oute0.
+move=> [] clae0 [] vb0 [] vt0 [] oe0 [] noc0 [] noc'0 [] pw0 lexevs.
+have u0 : uniq (outgoing ev) by apply: uniq_out_es; rewrite evsq mem_head.
+have oute : out_left_event ev by apply: out_es; rewrite evsq mem_head.
+have inbox_e : inside_box bottom top (point ev).
+  by have := inbox_es; rewrite evsq => /andP[].
+have /andP [pab put] : (point ev >>> bottom) && (point ev <<< top).
+  by move: inbox_e=> /andP[].
+have rf_closed1 : {in [:: close_cell (point ev) op0], forall c,
+      low c <| high c}.
+  rewrite /close_cell (pvertE vb0) (pvertE vt0) /= => c.
+  by rewrite inE=> /eqP -> /=.
+have dif1 : {in (nos ++ [:: lno]) ++
+                 [:: close_cell (point ev) op0], forall c, low c != high c}.
+  move=> c; rewrite mem_cat=> /orP[].
+    rewrite cats1.
+    have := opening_cells_low_diff_high oute u0 vb0 vt0 pab put.
+    by rewrite /opening_cells oca_eq; apply.
+  rewrite inE /close_cell (pvertE vb0) (pvertE vt0) => /eqP -> /=.
+  by apply/negP=> /eqP abs; move: pab; rewrite abs (underW put).
+have subc1 : {subset cell_edges [:: close_cell (point ev) op0] <= 
+    bottom :: top :: s}.
+  move=> c; rewrite !mem_cat !inE=> /orP[] /eqP ->.
+    have [-> _ _] := close_cell_preserve_3sides (point ev) op0.
+    by rewrite eqxx.
+  have [_ -> _] := close_cell_preserve_3sides (point ev) op0.
+  by rewrite eqxx orbT.
+have lte : {in evs, forall e, p_x (point ev) < p_x (point e)}.
+  move: gen_pos; rewrite evsq /=.
+  rewrite path_sortedE; last by move=> ? ? ?; apply: lt_trans.
+  by move=> /andP[] /allP.
+have llt: {in nos ++ [:: lno] & evs, forall c e, left_limit c < p_x (point e)}.
+  move=> c e cin ein.
+  have lte' : p_x (point ev) < p_x (point e) by apply: lte.
+  have := opening_cells_left oute vb0 vt0.
+  by rewrite /opening_cells oca_eq -cats1=> /(_ _ cin) => ->.
+have llop0ltev : left_limit op0 < p_x (point ev).
+  rewrite (leftmost_points_max startok).
+  have := inbox_e=> /andP[] _ /andP[] /andP[] + _ /andP[] + _.
+  by case: (lerP (p_x (left_pt bottom)) (p_x (left_pt top))).
+have lltr : {in [:: close_cell (point ev) op0], 
+  forall c, left_limit c < right_limit c}.
+  move=> c; rewrite inE=> /eqP ->.
+  rewrite (@right_limit_close_cell _ (point ev) op0 vb0 vt0).
+  by rewrite left_limit_close_cell.
+have clok: all (@closed_cell_side_limit_ok _) [:: close_cell (point ev) op0].
+  rewrite /= andbT.
+  by apply: close_cell_ok; rewrite // contains_pointE underWC // underW.
+have rllt : {in [:: close_cell (point ev) op0] & evs,
+               forall c e, right_limit c < p_x (point e)}.
+  move=> c e; rewrite inE => /eqP -> ein.
+  by rewrite right_limit_close_cell //; apply: lte.
+(* Main points. *)
+have safe_cl : {in events_to_edges [:: ev] & [:: close_cell (point ev) op0],
+         forall g c p, in_safe_side_left p c || in_safe_side_right p c -> 
+         ~ p === g}.
+  move=> g c gin.
+  have lgq : left_pt g = point ev.
+    apply/eqP/oute.
+    by move: gin; rewrite /events_to_edges /= cats0. 
+  rewrite inE => /eqP -> p /orP[] pin.
+    move=> /andP[] _ /andP[] + _.
+    rewrite leNgt=> /negP; apply.
+    move: pin=> /andP[] /eqP -> _.
+    by rewrite left_limit_close_cell lgq.
+  move=> pong.
+  move: pin=> /andP[] + /andP[] _ /andP[] _ .
+  rewrite right_limit_close_cell // => /eqP samex.
+  move/negP;apply.
+  suff -> : p = point ev by rewrite close_cell_in.
+  apply /(@eqP [eqType of pt]); rewrite pt_eqE samex eqxx.
+  apply: (on_edge_same_point pong).
+    by rewrite -lgq left_on_edge.
+  by apply/eqP.
+have safe_op : {in events_to_edges [:: ev] & nos ++ [:: lno],
+          forall g c p, in_safe_side_left p c -> ~ p === g}.
+  move=> g c gin cin p pin pong.
+  move: cin; rewrite cats1=> cin.
+  have lgq : left_pt g = point ev.
+    apply/eqP/oute.
+    by move: gin; rewrite /events_to_edges /= cats0. 
+  have eong : point ev === g by rewrite -lgq left_on_edge.
+  move: pin=> /andP[] + /andP[] _ /andP[] _.  
+  have := opening_cells_left oute vb0 vt0.
+  have := opening_cells_in vb0 vt0 oute.
+  rewrite /opening_cells oca_eq=> /(_ _ cin) evin /(_ _ cin) -> samex.
+  move/negP; apply.
+  suff -> : p = point ev.
+    by apply: (opening_cells_in vb0 vt0 oute); rewrite /opening_cells oca_eq.
+  apply/(@eqP [eqType of pt]); rewrite pt_eqE samex /=.
+  by apply: (on_edge_same_point pong eong samex).
+have cl_no_event : {in [:: ev] & [:: close_cell (point ev) op0],
+  forall e c (p : pt), in_safe_side_left p c || in_safe_side_right p c ->
+       p != point e}.
+  move=> e c; rewrite !inE => /eqP -> /eqP -> p /orP[].
+    move=> /andP[] xlop0 _.
+    apply/eqP=> pev.
+    move: llop0ltev; rewrite -pev (eqP xlop0).
+    by rewrite left_limit_close_cell lt_irreflexive.
+  move=> /andP[] _ /andP[] _ /andP[] _ /negP it; apply/eqP=> pev.
+  case: it; rewrite pev.
+  by apply: close_cell_in.
+have op_no_event : {in [:: ev] & nos ++ [:: lno],
+         forall e c (p : pt), in_safe_side_left p c -> p != point e}.
+  move=> e c; rewrite !inE=> /eqP ->; rewrite cats1=> cin p pin.
+  apply/negP=> /eqP pev.
+  move: pin=> /andP[] _ /andP[] _ /andP[] _ /negP[] .
+  have := opening_cells_in vb0 vt0 oute; rewrite /opening_cells oca_eq pev.
+  by apply.
+have lt_p_ev :
+  {in [:: ev] & evs, forall e1 e2 : event, p_x (point e1) < p_x (point e2)}.
+  by move=> e1 e2; rewrite inE => /eqP ->; apply: lte.
+have ll_o_b : 
+  {in nos ++ [:: lno], forall c, 
+       left_limit c < min (p_x (right_pt bottom)) (p_x (right_pt top))}.
+  move=> c cin.
+  have := opening_cells_left oute vb0 vt0; rewrite /opening_cells oca_eq.
+  rewrite -cats1 => /(_ _ cin) ->.
+  by apply: inside_box_lt_min_right.
+by constructor.
+Qed.
+
+Lemma start_safe_sides bottom top s closed open evs :
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) evs ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in one that is easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  all (inside_box bottom top) [seq point e | e <- evs] ->
+  sorted (@lexPtEv _) evs ->
+  {subset events_to_edges evs <= s} ->
+  {in evs, forall ev, out_left_event ev} ->
+  close_edges_from_events evs ->
+  {in s & evs, forall g e, non_inner g (point e)} ->
+  {in evs, forall e, uniq (outgoing e)} ->
+  main_process bottom top evs = (open, closed) ->
+ {in closed, forall c,
+     low c <| high c /\
+     low c != high c /\
+     left_limit c < right_limit c /\
+     closed_cell_side_limit_ok c /\
+    forall p : pt,
+     in_safe_side_left p c || in_safe_side_right p c ->
+     {in events_to_edges evs, forall g, ~ p === g} /\
+     {in evs, forall ev, p != point ev}} /\
+  {subset (cell_edges closed) <= [:: bottom, top & s]} /\
+  all (@closed_cell_side_limit_ok R) closed /\
+  size open = 1%N /\ low (head_cell open) = bottom /\
+    high (head_cell open) = top /\
+    {in open & closed, disjoint_open_closed_cells R} /\
+    (evs != [::] ->
+      left_limit (head_cell open) < min (p_x (right_pt bottom))
+      (p_x (right_pt top))).
+Proof.
+move=> ltev boxwf startok nocs' inbox_s evin lexev evsub out_evs cle
+  n_inner uniq_edges.
+have nocs : {in bottom :: top :: s &, no_crossing R}.
+  by apply: inter_at_ext_no_crossing.
+rewrite /main_process/scan/=.
+case evsq : evs => [ | ev future_events]; first by  move=> [] <- <-.
+have evsn0 : evs != [::] by rewrite evsq.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+set istate := Bscan _ _ _ _ _ _ _.
+have : safe_side_general_position_invariant bottom top s [:: ev]
+  istate future_events.
+  have := initial_safe_side_general_position ltev lexev boxwf cle startok
+    nocs' n_inner evin evsub out_evs uniq_edges evsn0.
+  by rewrite evsq /= oca_eq.
+move=> invss req.
+suff main: forall events op cl st processed_set, 
+  safe_side_general_position_invariant bottom top s processed_set st events ->
+  scan events st = (op, cl) ->
+  {in cl, forall c,
+    low c <| high c /\
+    low c != high c /\
+    left_limit c < right_limit c /\
+    closed_cell_side_limit_ok c /\
+    forall p : pt, in_safe_side_left p c || in_safe_side_right p c ->
+    {in events_to_edges (processed_set ++ events), forall g, ~ p === g} /\
+         {in processed_set ++ events, forall e', p != point e'}} /\
+  {in op, forall (c : cell) (p : pt), in_safe_side_left p c ->
+         {in events_to_edges (processed_set ++ events), forall g, ~ p === g} /\
+         {in processed_set ++ events, forall e', p != point e'}} /\
+  {subset (cell_edges cl) <= [:: bottom, top & s]} /\
+  all (@closed_cell_side_limit_ok _) cl /\
+  size op = 1%N /\
+  low (head_cell op) = bottom /\
+  high (head_cell op) = top /\
+  {in op & cl, disjoint_open_closed_cells R} /\
+  (left_limit (head_cell op) < min (p_x (right_pt bottom))
+      (p_x (right_pt top))).
+  have [A [B [C [D [E [F [G [H I]]]]]]]] := main _ _ _ _ _ invss req.
+  split; last by [].
+  move=> c cin; move: (A c cin) => [] crf [] difc [] lltr [] clok A'.
+  do 4 (split; first by []).
+  by move=> p pside; have := A' _ pside.
+elim=> [ | {evsq oca_eq istate invss}ev {req}future_events Ih] op cl st p_set.
+  case stq : st => [fop lsto lop cls lstc lsthe lstx] [].
+  move=> d_inv e_inv.
+  set c_inv := common_inv_dis d_inv.
+  rewrite /state_open_seq/state_closed_seq/= => old_lt_fut b_e d_e subc
+     lolt lo_lb rllt clok rl A B C D.
+  rewrite /= => -[] <- <-; rewrite !cats0.
+  split.
+    move=> c cin.
+    split; first by apply: b_e; rewrite mem_rcons.
+    split; first by apply: d_e; rewrite mem_cat mem_rcons cin orbT.
+    split; first by apply: rllt; rewrite mem_rcons.
+    split; first by apply: (allP clok); rewrite mem_rcons.
+    move=> p pin; split.
+      by move=> g gin; apply: (A g c gin); rewrite // mem_rcons.
+    by move=> e ein; apply: (C e c ein); rewrite // mem_rcons.
+  split; last first.
+    split; last first.
+      split.
+        rewrite (eq_all_r (_ : lstc :: cls =i rcons cls lstc)) //.
+        by move=> c; rewrite mem_rcons.
+      (* TODO : find a place for this as a lemma. *)
+      have [[] + + _ _ _ _ _ _ _ + _] := c_inv; rewrite /state_open_seq/=.
+      rewrite /state_open_seq/= /close_alive_edges => clae.
+      move=> [] _ [] adj [] cbtom rfo _.
+      have htop : {in fop ++ lsto :: lop, forall c, high c = top}.
+        move=> c cin.
+        have := allP clae _ cin; rewrite /end_edge_ext ?orbF => /andP[] lP.
+        rewrite !inE => /orP[] /eqP hcq; rewrite hcq //.
+        have := d_e c; rewrite mem_cat cin hcq=> /(_ isT).
+        move: lP; rewrite !inE => /orP[] /eqP lcq; rewrite lcq ?eqxx //.
+        move: evin; rewrite evsq /= => /andP[] + _.
+        move=> /[dup]/inside_box_valid_bottom_top vbt.
+        have vb : valid_edge bottom (point ev) by apply: vbt; rewrite inE eqxx.
+        have vt : valid_edge top (point ev).
+          by apply: vbt; rewrite !inE eqxx orbT.
+        move=> /andP[] /andP[] pab put _ tnb.
+        have abs : top <| bottom by rewrite -lcq -hcq; apply: (allP rfo).
+        have := order_edges_strict_viz_point' vt vb abs put.
+        by move: pab; rewrite under_onVstrict // orbC => /[swap] ->.
+      have := inj_high e_inv; rewrite /state_open_seq/= => ijh.
+      have f0 : fop = [::].
+        elim/last_ind: (fop) adj ijh htop => [ // | fs f1 _] + ijh htop.
+        rewrite -cats1 -catA /= => /adjacent_catW[] _ /= /andP[] /eqP f1l _.
+        move: (d_e lsto); rewrite !mem_cat inE eqxx ?orbT => /(_ isT).
+        rewrite -f1l (htop f1); last by rewrite !(mem_rcons, mem_cat, inE) eqxx.
+        by rewrite (htop lsto) ?eqxx // mem_cat inE eqxx ?orbT.
+      have l0 : lop = [::].
+        case lopq: (lop) adj ijh htop => [ // | l1 ls] + ijh htop.
+        move=> /adjacent_catW[] _ /= /andP[] /eqP hl _.
+        move: (d_e l1); rewrite lopq !(mem_cat, inE) eqxx ?orbT => /(_ isT).
+        rewrite -hl (htop l1); last by rewrite !(mem_cat, inE) eqxx !orbT.
+        by rewrite (htop lsto) ?eqxx // mem_cat inE eqxx ?orbT.
+      rewrite f0 l0 /=.
+      move: cbtom; rewrite f0 l0 /= /cells_bottom_top /cells_low_e_top /=.
+      move=> /andP[] /eqP lq /eqP hq.
+      do 3 (split; first by []).
+      split.
+        move=> c1 c2 c1in c2in; apply: (op_cl_dis d_inv);
+        by rewrite /state_open_seq/state_closed_seq  f0 l0 ?mem_rcons.
+      by apply: lo_lb; rewrite mem_cat inE eqxx orbT.
+(* End of lemma *)
+    move=> g; rewrite -[lstc :: cls]/([:: lstc] ++ cls) cell_edges_catC cats1.
+    by apply: subc.
+  move=> c cin p pin.
+  split.
+    by move=> g gin; apply: (B g c gin).
+  by move=> g gin; apply: (D g c gin).
+rewrite /scan/=.
+move=> [] d_inv e_inv old_lt_fut rf_cl d_e subc lolt lo_lb rllt clok rl A B C D.
+set c_inv := common_inv_dis d_inv.
+rewrite /step/generic_trajectories.step/=.
+case stq : st => [fop lsto lop cls lstc lsthe lstx].
+have /andP[/andP[+ _] _] := general_pos c_inv.
+rewrite lt_neqAle=> /andP[] + _.
+rewrite stq eq_sym /= => ->.
+rewrite -/(open_cells_decomposition _ _).
+case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
+rewrite /simple_step/generic_trajectories.simple_step/=.
+rewrite -/(opening_cells_aux _ _ _ _).
+case oca_eq : (opening_cells_aux _ _ _ _) => [{}nos {}lno].
+rewrite -(cat_rcons ev).
+apply: Ih.
+have [clae [pre_sval [adj [cbtom rfo]]]] := inv1 c_inv.
+move: pre_sval=> [| sval]; first by[].
+have inbox_es := inbox_events c_inv.
+have inbox_e : inside_box bottom top (point ev) by move: inbox_es=>/andP[].
+move: (oe); rewrite (_ : fop ++ lsto :: lop = state_open_seq st); last first.
+  by rewrite stq.
+move=> oe'.
+have exi' := exists_cell cbtom adj (inside_box_between inbox_e).
+move: (exi'); rewrite stq => exi.
+have [ocd [lcc_ctn [allct [allnct [flcnct [heq [leq [lein hein]]]]]]]] :=
+  decomposition_main_properties oe' exi'.
+have [{}pal {}puh vl vp nc]:=
+  decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe'.
+have oute : out_left_event ev.
+  by apply: (out_events c_inv); rewrite inE eqxx.
+have oute' :
+  {in (sort (@edge_below _) (outgoing ev)), forall g, left_pt g == point ev}.
+  by move=> g; rewrite mem_sort; apply: oute.
+set rstate := Bscan _ _ _ _ _ _ _.
+have d_inv': 
+  disjoint_general_position_invariant bottom top s rstate future_events.
+  move: (d_inv); rewrite stq=> d_inv'.
+  have := simple_step_disjoint_general_position_invariant boxwf nocs'
+      inbox_s oe d_inv'.
+  rewrite /simple_step/generic_trajectories.simple_step/=.
+  by rewrite -/(opening_cells_aux _ _ _ _) oca_eq.
+have e_inv' :edge_covered_general_position_invariant bottom top s
+    (rcons p_set ev) rstate future_events.
+  move: e_inv; rewrite stq=> e_inv.
+  have := simple_step_edge_covered_general_position boxwf nocs'
+      inbox_s oe e_inv.
+  rewrite /simple_step/generic_trajectories.simple_step/=.
+  by rewrite -/(opening_cells_aux _ _ _ _) oca_eq.
+(* Proving that low and high edges of every cell are distinct. *)
+have low_diff_high' :
+  {in state_open_seq rstate ++
+      state_closed_seq rstate, forall c : cell, low c != high c}.
+  move=> c; rewrite mem_cat=> /orP[].
+    rewrite /state_open_seq /= -catA -cat_rcons !mem_cat orbCA.
+    move=> /orP[ | cold]; last first.
+      by apply: d_e; rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+    have uo : uniq (outgoing ev) by apply: (uniq_ec e_inv) (mem_head _ _).
+    have := opening_cells_low_diff_high oute uo vl vp pal puh.
+    by rewrite /opening_cells oca_eq; apply.
+  rewrite /state_closed_seq /= -cats1 -!catA /= -cat_rcons.
+  rewrite mem_cat => /orP[cold | ].
+    by apply: d_e; rewrite mem_cat stq /state_closed_seq/= cold orbT.
+  rewrite cats1 -map_rcons=> /mapP[c' c'in ->].
+  have [-> -> _] := close_cell_preserve_3sides (point ev) c'.
+  by apply: d_e; rewrite mem_cat ocd -cat_rcons !mem_cat c'in !orbT.
+(* Provint that closed cells used edges only from the initial set. *)
+have subc' :
+  {subset cell_edges (state_closed_seq rstate) <= [:: bottom, top & s]}.
+  move=> g; rewrite /state_closed_seq/= -cats1 -catA /= -cat_rcons.
+  rewrite cell_edges_cat mem_cat=> /orP[gold | ].
+    by apply: subc; rewrite stq.
+  have subo := edges_sub c_inv.
+  rewrite cats1 -map_rcons mem_cat=> /orP[] /mapP[c'] /mapP[c2 c2in ->] ->.
+    have [-> _ _] := close_cell_preserve_3sides (point ev) c2.
+    apply: subo; rewrite !mem_cat; apply/orP; left; apply/orP; left.
+    by rewrite map_f // ocd -cat_rcons !mem_cat c2in orbT.
+  have [_ -> _] := close_cell_preserve_3sides (point ev) c2.
+  apply: subo; rewrite !mem_cat; apply/orP; left; apply/orP; right.
+  by rewrite map_f // ocd -cat_rcons !mem_cat c2in orbT.
+(* Proving that open cells have a left side that is smaller than any
+   event first coordinate. *)
+have loplte : {in state_open_seq rstate & future_events,
+    forall (c : cell) (e : event), left_limit c < p_x (point e)}.
+  move=> c e; rewrite /state_open_seq/= -catA -cat_rcons => cin ein.
+  move: cin; rewrite !mem_cat orbCA => /orP[ | cold ]; last first.
+    apply: lolt; first by rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+    by rewrite inE ein orbT.
+  have := opening_cells_left oute vl vp; rewrite /opening_cells oca_eq=> main.
+  move=> /main=> ->.
+  move: (proj2 (andP (general_pos c_inv))).
+  rewrite /= path_sortedE; last by move=> x y z; apply: lt_trans.
+  by move=> /andP[] /allP /(_ _ ein).
+(* Proving that cells have distinct left and right sides. *)
+have lltr :
+ {in state_closed_seq rstate, forall c : cell, left_limit c < right_limit c}.
+  rewrite /state_closed_seq/= -cats1 -catA /= -cat_rcons.
+  move=> c; rewrite mem_cat=> /orP[cold | ].
+    by apply: rllt; rewrite stq.
+  rewrite cats1 -map_rcons=> /mapP [c' c'in ->].
+  have [vlc' vhc'] : valid_edge (low c') (point ev) /\
+                         valid_edge (high c')(point ev).
+     apply/andP; have := allP sval; rewrite ocd -cat_rcons=> /(_ c'); apply.
+     by rewrite !mem_cat c'in orbT.
+  have := right_limit_close_cell vlc' vhc'=> ->.
+  rewrite left_limit_close_cell lolt //; last by rewrite inE eqxx.
+  by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+(* proving a closed_cell ok invariant. *)
+have clok' : all (@closed_cell_side_limit_ok _) (state_closed_seq rstate).
+  apply/allP; rewrite /state_closed_seq/= -cats1 -catA /= -cat_rcons.
+    move=> c; rewrite mem_cat=> /orP[cin | cin].
+    by apply: (allP clok); rewrite stq.
+  move: cin; rewrite /closing_cells cats1 -map_rcons=> /mapP[c' c'in ->].
+  have ccont : contains_point (point ev) c'.
+    by move: c'in; rewrite mem_rcons inE => /orP[/eqP -> | /allct].
+  have c'in' : c' \in state_open_seq st.
+    by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+  have /(allP sval) /= /andP[vlc' vhc'] := c'in'.
+  have c'ok : open_cell_side_limit_ok c'.
+    by apply: (allP (sides_ok c_inv)).
+  by apply close_cell_ok.
+(* proving a right_limit stronger invariant. *)
+have rllte :   {in state_closed_seq rstate & future_events,
+    forall (c : cell) (e : event), right_limit c < p_x (point e)}.
+  rewrite /state_closed_seq/=.
+  move=> c e cin ein.
+  move: cin; rewrite -cats1 -catA /= -cat_rcons mem_cat=> /orP[cold | cnew].
+    by apply: rl; rewrite ?stq // inE ein orbT.
+  have in_es := inbox_events c_inv.
+  have := closing_cells_to_the_left in_es rfo cbtom adj sval.
+  rewrite stq=> /(_ _ _ _ _ _ _ oe)=> -[] main1 main2.
+  have eve : p_x (point ev) < p_x (point e).
+    have:= general_pos c_inv=> /andP[] _ /=.
+    rewrite path_sortedE; last by move=> x y z; apply: lt_trans.
+    by move=> /andP[] /allP /(_ e ein).
+  apply: le_lt_trans eve.
+  move: cnew; rewrite mem_cat=> /orP[cin | ]; last first.
+    by rewrite inE=> /eqP ->.
+  by apply: (main1 _ cin).
+
+have safe_side_bound : {in rcons cls lstc, forall c p,
+       in_safe_side_left p c || in_safe_side_right p c ->
+       p_x p <= right_limit c}.
+  move=> c p cin /orP[] /andP[] /eqP -> _; last by rewrite le_refl.
+  by apply/ltW/rllt; rewrite /state_closed_seq stq.
+have not_safe_event : {in rcons (closing_cells (point ev) cc)
+                                 (close_cell (point ev) lcc), forall c,
+   ~~ (in_safe_side_left  (point ev) c || in_safe_side_right (point ev) c)}.
+  move=> c cin; apply/negP.
+  move: cin; rewrite -map_rcons=> /mapP[c' c'in cq].
+  have c'in' : c' \in state_open_seq st.
+    by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+  move=> /orP[ /andP[] + _ | /andP[] _ /andP[] _ /andP[] _ ].
+    rewrite cq left_limit_close_cell=> /eqP abs.
+    have := lolt c' _ c'in' (mem_head _ _).
+    by rewrite  abs lt_irreflexive.
+  by rewrite cq close_cell_in //; apply/andP/(allP sval).
+have in_safe_side_left_close_cell :
+  {in rcons cc lcc, forall c p, in_safe_side_left p (close_cell (point ev) c) =
+        in_safe_side_left p c}.
+  move=> c cin p; rewrite /in_safe_side_left.
+  have [-> -> ->] := close_cell_preserve_3sides (point ev) c.
+  by rewrite left_limit_close_cell.
+(* Now comes the real important property. *)
+have cl_safe_edge :
+  {in events_to_edges (rcons p_set ev) & state_closed_seq rstate,
+    forall (g : edge) (c : cell) (p : pt),
+    in_safe_side_left p c || in_safe_side_right p c -> ~ p === g}.
+  rewrite events_to_edges_rcons /state_closed_seq/=.
+  move=> g c gin cin p pin.
+  move: cin; rewrite -cats1 -catA /= -cat_rcons mem_cat=> /orP[cold | cnew].
+    move: gin; rewrite mem_cat=> /orP[gold | gnew].
+      (* the edge and the cell are old *)
+      by apply: (A g c); rewrite // stq /state_closed_seq/=.
+  (* the edge is new, the cell is old, I need to prove the events would
+     need to be vertically aligned here. *)
+    have cin' : c \in state_closed_seq st by rewrite stq.
+    have abs := rl _ _ cin' (mem_head _ _).
+    move=> /andP[] _ /andP[] + _.
+    have := out_events c_inv (mem_head _ _) gnew=> /eqP ->.
+  (* TODO : have the same condition, but for the right side of closed cells. *)
+    suff prl : p_x p <= right_limit c.
+      rewrite leNgt=> /negP; apply.
+      by apply: le_lt_trans abs.
+    have cold' : c \in state_closed_seq st by rewrite stq.
+    move: pin => /orP[]; last first.
+      by rewrite /in_safe_side_right => /andP[] /eqP -> _.
+    rewrite /in_safe_side_left=> /andP[] /eqP -> _.
+    by apply/ltW/rllt.
+  (* now the cells are newly closed. *)
+  move: cnew pin; rewrite cats1 /closing_cells -map_rcons.
+  move=> /mapP[c' c'in ->].
+  have c'in' : c' \in state_open_seq st.
+    by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+  move=> /orP[pin | pin].
+    have pin': in_safe_side_left p c'.
+      by move: pin; rewrite in_safe_side_left_close_cell.
+    move: pin=> /andP[]; rewrite left_limit_close_cell => pl _.
+    move: gin; rewrite mem_cat=> /orP[gin | ].
+      by apply: B pin'.
+    move=> /oute /eqP lgq /andP[] _ /andP[]; rewrite lgq leNgt=> /negP[].
+    by rewrite (eqP pl); apply: lolt; rewrite // inE eqxx.
+  have vc' : valid_cell c' (point ev) by apply/andP/(allP sval).
+  have samex : p_x p == p_x (point ev).
+    by move: pin=> /andP[] + _; rewrite close_cell_right_limit.
+  move: gin; rewrite mem_cat=> /orP[gin | /oute/eqP lgq ]; last first.
+    have peg : point ev === g by rewrite -lgq left_on_edge.
+    move=> pong.
+    have samey := on_edge_same_point pong peg samex.
+    have pev : p = point ev by apply/eqP; rewrite pt_eqE samex samey.
+    have := not_safe_event (close_cell (point ev) c').
+    rewrite -[e in in_safe_side_right e _]pev pin orbT.
+    by rewrite /closing_cells -map_rcons map_f // => /(_ isT).
+  move: gin=> /flatten_mapP[e' e'in gin].
+  have := edge_covered_ec e_inv e'in gin=> -[]; last first.
+    move=> [[ | pcc0 pcc] []]; first by []. 
+    move=> _ /= [pccsub [pcchigh [_ [_ rlpcc]]]] /andP[] _ /andP[] _.
+    rewrite leNgt=> /negP; apply.
+    rewrite (eqP samex).
+    rewrite -rlpcc; apply:rl; last by rewrite inE eqxx.
+    by apply/pccsub; rewrite /last_cell /= mem_last.
+  move=> [] opc [] pcc [] _ [] opch [] _ [] opco _ abs.
+  have [vlc'p vhc'p] : valid_edge (low c') p /\ valid_edge (high c') p.
+    by move: vc'; rewrite /valid_cell !(same_x_valid _ samex).
+  have pinc' : contains_point' p c'.
+    rewrite /contains_point'.
+    have [<- <- _] := close_cell_preserve_3sides (point ev) c'.
+    by have /andP[_ /andP[] /underW -> /andP[] ->] := pin.
+  have {}opch : high opc = g by apply: opch; rewrite mem_rcons inE eqxx.
+  have [vplc vphc] : valid_edge (low opc) p /\ valid_edge (high opc) p.
+    by rewrite !(same_x_valid _ samex); apply/andP/(allP sval).
+  have rfc : low opc <| high opc by apply: (allP rfo).
+  have cnt : contains_point p opc.
+    rewrite contains_pointE; apply/andP; rewrite under_onVstrict; last first.
+      by have := (allP sval _ opco) => /andP[].
+    rewrite opch abs; split; last by [].
+    apply/negP=> pun.
+    have := order_edges_strict_viz_point' vplc vphc rfc pun.
+    by apply/negP/onAbove; rewrite opch.
+  have pw : pairwise (@edge_below _) [seq high c | c <- state_open_seq st].
+    by move: (pairwise_open d_inv)=> /= /andP[].
+  have [puhc' palc'] : p <<< high c' /\ p >>> low c'.
+    apply/andP;  move: pin=> /andP[] _ /andP[] + /andP[] + _.
+    by have [-> -> _] := close_cell_preserve_3sides (point ev) c' => ->.
+  have : p >>= low opc by move: cnt=> /andP[].
+  rewrite strict_nonAunder // negb_and negbK=> /orP[ | stricter]; last first.
+    have := disoc adj pw (sides_ok c_inv)=> /(_ opc c' opco c'in') [ab' | ].
+      by move: puhc'; rewrite strict_nonAunder // -ab' opch abs.
+    move=> /(_ p) + ; move=>/negP.
+    rewrite inside_open'E stricter valid_open_limit //.
+    move: cnt; rewrite contains_pointE=> /andP[] _ ->.
+    rewrite (eqP samex) lolt //=; last by rewrite inE eqxx.
+    rewrite inside_open'E (underW puhc') palc' valid_open_limit //.
+    by rewrite (eqP samex) lolt // inE eqxx.
+  move=> ponl.
+  have vbp : valid_edge bottom p.
+    by rewrite (same_x_valid _ samex) (inside_box_valid_bottom inbox_e).
+  have vtp : valid_edge top p.
+    rewrite (same_x_valid _ samex) /valid_edge/generic_trajectories.valid_edge.
+    by move: inbox_e=> /andP[] _ /andP[] _ /andP[] /ltW -> /ltW ->.
+  have bottom_b_c' : bottom <| low c'.
+    have [-> | ] := eqVneq bottom (low c'); first by apply: edge_below_refl.
+    have  [s1 [s2]] := mem_seq_split c'in'.
+    elim/last_ind: s1 => [ | s1 op' _] /= => odec.
+      by move: cbtom => /andP[]; rewrite odec /= => /eqP ->; rewrite eqxx.
+    have := adj.
+    rewrite odec cat_rcons=> /adjacent_catW /= [] _ /andP[] /eqP <- _ _.
+    have := pairwise_open d_inv=> /= /andP[] /allP /(_ (high op')) + _.
+    apply; apply/mapP; exists op'=> //.
+    by rewrite // odec !mem_cat mem_rcons inE eqxx.
+  have pab : p >>> bottom.
+    apply/negP=> pub.
+    have:= order_edges_viz_point' vbp vlc'p bottom_b_c' pub.
+    by move: palc'=> /[swap] => ->.
+  have ldifh : low opc != high opc by apply: d_e; rewrite mem_cat opco.
+  have low_opc_s : low opc \in [:: bottom, top & s].
+    by apply: (edges_sub c_inv); rewrite !mem_cat map_f.
+  have high_opc_s : high opc \in [:: bottom, top & s].
+    by apply: (edges_sub c_inv); rewrite !mem_cat map_f ?orbT.
+  have := nocs' (low opc) (high opc) low_opc_s high_opc_s.
+  move=> [Q | ]; first by rewrite Q eqxx in ldifh.
+  have ponh : p === high opc by rewrite opch.
+  have opcok : open_cell_side_limit_ok opc by apply: (allP (sides_ok c_inv)).
+  move=> /(_ _ ponl ponh); rewrite !inE=> /orP[/eqP pleft | /eqP].
+    have : left_limit opc < p_x p.
+      by rewrite (eqP samex); apply: lolt; rewrite // inE eqxx.
+    have := left_limit_max opcok.
+    have [_ | ] := lerP (p_x (left_pt (high opc)))(p_x (left_pt (low opc))).
+      by move=> /le_lt_trans /[apply]; rewrite pleft lt_irreflexive.
+    move=> /lt_le_trans /[apply]=> /lt_trans /[apply].
+    by rewrite pleft lt_irreflexive.
+(* Here p is vertically aligned with p_x, but it must be an event,
+   because it is the end of an edge. *)
+  move=> prl.
+  have put : p <<< top.
+    apply: (order_edges_strict_viz_point' vhc'p vtp _ puhc').
+    move: cbtom=> /andP[] _.
+    have := pw.
+    have [s1 [s2 s1q]] := mem_seq_split c'in'.
+    rewrite s1q last_cat /= map_cat pairwise_cat /=.
+    move=> /andP[] _ /andP[] _ /andP[] allabovec' _ /eqP highlast.
+    case s2q : s2 => [ | c2 s3].
+      by rewrite -highlast s2q edge_below_refl.
+    have /(allP allabovec') : (high (last c' s2)) \in [seq high c | c <- s2].
+      by rewrite map_f // s2q /= mem_last.
+    by rewrite highlast.
+  have := (allP clae _ opco)=> /andP[] + _ => /orP[].
+    rewrite !inE => /orP[] /eqP=> ab'.
+      by move: pab; rewrite under_onVstrict // -ab' ponl.
+    by move: put; rewrite strict_nonAunder // -ab' ponl.
+  move=> /hasP[e2 + /eqP pe2]; rewrite inE=> /orP[/eqP e2ev | e2in].
+  (* if e' cannot be ev, because p cannot be ev because of pin *)
+    have := pin=> /andP[].
+    by rewrite prl pe2 e2ev close_cell_in // ?andbF.
+(* if e' is in future_events, then e' and p cannot have the same p_x,
+  because e' and ev don't, but p and e' are at the same point *)
+    have /andP[_ /=]:= general_pos c_inv.
+  rewrite path_sortedE; last by move=> ? ? ?; apply: lt_trans.
+  move=> /andP[] /allP /(_ e2 e2in).
+  by rewrite -pe2 -prl (eqP samex) lt_irreflexive.
+have op_safe_edge :
+  {in events_to_edges (rcons p_set ev) & state_open_seq rstate,
+    forall g c p, in_safe_side_left p c -> ~ p === g}.
+(* We should re-use the proof that was just done. *)
+  move=> g c gin; rewrite /rstate/state_open_seq/=.
+  rewrite -catA -cat_rcons !mem_cat orbCA=> /orP[cnew | cold]; last first.
+    have cin : c \in state_open_seq st.
+      by rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+    move: gin; rewrite events_to_edges_rcons mem_cat=> /orP[gold | gnew].
+      by apply: (B _ _ gold cin).
+    move=> p pin /andP[] _ /andP[] pong _.
+    have := lolt _ _ cin (mem_head _ _).
+    move: (pin)=> /andP[] /eqP <- _.
+    rewrite ltNge=> /negP; apply.
+    by move: pong; rewrite (eqP (oute _ gnew)).
+  move=> p pin.
+  have : has (in_safe_side_left p) 
+           (opening_cells (point ev) (outgoing ev) le he).
+    by apply/hasP; exists c; rewrite // /opening_cells oca_eq.
+  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=. 
+  move=> /(_ _ _ _ _ _ _ oe p) /eqP <- => /hasP[] c' c'in pin'.
+  have := cl_safe_edge _ c' gin; apply.
+    by rewrite /rstate /state_closed_seq/= rcons_cat /= mem_cat inE c'in ?orbT.
+  by rewrite pin' orbT.
+have cl_safe_event :
+  {in rcons p_set ev & state_closed_seq rstate, forall e c (p : pt),
+     in_safe_side_left p c || in_safe_side_right p c -> p != point e}.
+  move=> e c; rewrite mem_rcons inE=> /orP[/eqP -> | ein].
+    move=> cin p pin; apply/negP=> /eqP pev.
+    move: cin.
+    rewrite /rstate/state_closed_seq/= -cats1 -catA /= -cat_rcons mem_cat.
+    move=> /orP[]; last by rewrite cats1=> /not_safe_event; rewrite -pev pin.
+    move=> cin; have cin' : c \in state_closed_seq st by rewrite stq.
+    move: (cin)=> /safe_side_bound/(_ _ pin); rewrite pev leNgt=> /negP; apply.
+    by apply: (rl _ _ cin' (mem_head _ _)).
+  rewrite /rstate/state_closed_seq/= -cats1 -catA /= -cat_rcons mem_cat.
+  move=> /orP[cin | ].
+    have cin' : c \in state_closed_seq st by rewrite stq.
+    by apply: (C _ _ ein cin').
+  rewrite cats1 -map_rcons=> /mapP[c' c'in /[dup] cq ->].
+  have c'in' : c' \in state_open_seq st.
+    by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+  move=> p /orP[] pin.
+    apply: (D e c' ein c'in').
+    by move: pin; rewrite in_safe_side_left_close_cell.
+  have /andP[vlc' vhc'] : valid_edge (low c') (point ev) &&
+                                   valid_edge (high c') (point ev).
+    by apply: (allP sval).
+  move: (pin) => /andP[] + _.
+  rewrite right_limit_close_cell // => /eqP pxq.
+  apply/eqP=> abs.
+  have := old_lt_fut _ _ ein (mem_head _ _).
+  by rewrite -abs pxq lt_irreflexive.
+have op_safe_event :
+{in rcons p_set ev & state_open_seq rstate,
+    forall (e : event) (c : cell) (p : pt),
+    in_safe_side_left p c -> p != point e}.
+  move=> e c ein; rewrite /rstate/state_open_seq/=.
+  rewrite -catA -cat_rcons !mem_cat orbCA=> /orP[cnew | cold]; last first.
+    have cin : c \in state_open_seq st.
+      by rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+    move: ein; rewrite mem_rcons inE=> /orP[/eqP -> | eold]; last first.
+      by apply: (D _ _ eold cin).
+    (* use lolt *)
+    have := lolt _ _ cin (mem_head _ _)=> llt p /andP[] /eqP pll _.
+    apply/eqP=> pev.
+    by move: llt; rewrite -pll pev lt_irreflexive.
+  move=> p pin.
+  have : has (in_safe_side_left p) 
+           (opening_cells (point ev) (outgoing ev) le he).
+    by apply/hasP; exists c; rewrite // /opening_cells oca_eq.
+  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=. 
+  move=> /(_ _ _ _ _ _ _ oe p) /eqP <- => /hasP[] c' c'in pin'.
+  have := cl_safe_event _ c' ein; apply.
+    by rewrite /rstate /state_closed_seq/= rcons_cat /= mem_cat inE c'in ?orbT.
+  by rewrite pin' orbT.
+have old_lt_fut' :
+  {in rcons p_set ev & future_events,
+     forall e1 e2, p_x (point e1) < p_x (point e2)}.
+  move=> e1 e2; rewrite mem_rcons inE=>/orP[/eqP -> | e1old] e2fut; last first.
+    by apply: old_lt_fut; rewrite // inE e2fut orbT.
+  have := general_pos c_inv=> /andP[] _ /=.
+  rewrite path_sortedE; last by move=> ? ? ?; apply: lt_trans.
+  by move=> /andP[] /allP + _; apply.
+have rf_closed1 : {in state_closed_seq rstate, forall c, low c <| high c}.
+  move=> c; rewrite /rstate/state_closed_seq/=.
+  rewrite appE -cat_rcons -cats1 -catA.
+  rewrite mem_cat=> /orP[cin | ].
+    by apply: rf_cl; rewrite /state_closed_seq stq/=.
+  rewrite cats1 -map_rcons=> /mapP[c' c'in ->].
+  have [-> -> _] := close_cell_preserve_3sides (point ev) c'.
+  have [+ _ _ _ _ _ _ _ _ _] := c_inv.
+  move=> [] _ [] _ [] _ [] _ /allP; apply.
+  by rewrite ocd -cat_rcons !mem_cat c'in orbT.
+have lo_lb' : {in state_open_seq rstate, forall c,
+               left_limit c < min (p_x (right_pt bottom)) (p_x (right_pt top))}.
+  move=>c; rewrite /state_open_seq/= -catA -cat_rcons !mem_cat orbCA.
+  move=> /orP[cnew | cold]; last first.
+    by apply: lo_lb; rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
+  have := opening_cells_left oute vl vp ; rewrite /opening_cells oca_eq.
+  move=> /(_ _ cnew) ->.
+  by apply: inside_box_lt_min_right.
+by constructor.
+Qed.
+  
+(*  
+
+Lemma start_cover (bottom top : edge) (s : seq edge) closed open :
+  bottom <| top ->
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, no_crossing R} ->
+  all (inside_box bottom top) [seq left_pt x | x <- s] ->
+  all (inside_box bottom top) [seq right_pt x | x <- s] ->
+  start (edges_to_events s) bottom top = (closed, open) ->
+  forall p, inside_box bottom top p ->
+  has (inside_closed' p) closed || has (inside_open' p) open.
+Proof.
+move=> boxwf boxwf2 nocs leftin rightin; rewrite /start.
+set evs := edges_to_events s.
+have/perm_mem := edges_to_events_no_loss s.
+  rewrite -/evs/events_to_edges/= => stoevs.
+set op0 := [:: Bcell (leftmost_points bottom top) [::] bottom top].
+set cl0 := (X in scan _ _ X).
+have : sorted (@lexPt R) [seq point x | x <- evs].
+  by apply: sorted_edges_to_events.
+have : cells_bottom_top bottom top op0.
+  by rewrite /op0/cells_bottom_top/cells_low_e_top/= !eqxx.
+have : adjacent_cells op0 by [].
+have : s_right_form op0 by rewrite /= boxwf.
+have : close_alive_edges bottom top op0 evs.
+  by rewrite /=/end_edge !inE !eqxx !orbT.
+have : {in cell_edges op0 ++ flatten [seq outgoing i | i <- evs] &,
+         no_crossing R}.
+  rewrite /=; move: nocs; apply sub_in2.
+  move=> x; rewrite !inE => /orP[ -> // | /orP[-> // | ]]; rewrite ?orbT //.
+  by rewrite -stoevs => ->; rewrite ?orbT.
+have : {in evs, forall ev, out_left_event ev}.
+  by apply: out_left_edges_to_events.
+have : close_edges_from_events bottom top evs.
+  by apply: edges_to_events_wf.
+have evsin0 : all (inside_box bottom top)
+    [seq point ev | ev <- evs].
+  apply/allP.
+  have : {subset [seq right_pt g | g <- s] <= inside_box bottom top}.
+    by apply/allP: rightin.
+  have : {subset [seq left_pt g | g <- s] <= inside_box bottom top}.
+    by apply/allP: leftin.
+  by apply: edges_to_events_subset.
+have btm_left0 : {in [seq point e | e <- evs], 
+         forall e,  bottom_left_cells_lex op0 e}.
+  move=> ev /[dup] /(allP evsin0) /andP[_ /andP[valb valt]] evin c.
+  rewrite /op0 inE /lexPt /bottom_left_corner=> /eqP -> /=.
+  by apply/orP; left; apply/inside_box_left_ptsP/(allP evsin0).
+have sval0 :
+  evs != nil -> seq_valid op0 (head dummy_pt [seq point ev | ev <- evs]).
+  case evseq : evs => [// | ev evs'] _ /=; rewrite andbT.
+  move: evsin0; rewrite evseq /= => /andP[] /andP[] _ /andP[] ebot etop _.
+  have betW : forall a b c : R, a < b < c -> a <= b <= c.
+    by move=> a b c /andP[] h1 h2; rewrite !ltW.
+  by rewrite /valid_edge !betW.
+have cov0 : forall p, all (lexePt p) [seq point ev | ev <- evs] ->
+         cover_left_of bottom top p op0 cl0.
+  move=> p limrp q inbox_q qp; apply/orP; left; apply/hasP.
+  exists (Bcell (leftmost_points bottom top) nil bottom top).
+    by rewrite /op0 inE eqxx.
+  rewrite inside_open'E.
+  apply/andP; split;[ | apply/andP; split].
+  - by apply: underW; move: inbox_q=> /andP[] /andP[].
+  - by move: inbox_q=> /andP[] /andP[].
+  - rewrite /open_limit /=.
+    case: (ltrP  (p_x (right_pt bottom)) (p_x (right_pt top))) => _.
+    rewrite inside_box_left_ptsP //.
+    by move: inbox_q => /andP[] _ /andP[] /andP[] _ /ltW ->.
+  rewrite inside_box_left_ptsP //.
+  by move: inbox_q => /andP[] _ /andP[] _ /andP[] _ /ltW ->.
+have leftlim0 : {in op0, forall c p, inside_box bottom top p ->
+         left_limit c = p_x p ->
+         contains_point' p c -> has (inside_closed' p) cl0}.
+  move=> c + p; rewrite inE -[Bcell _ _ _ _]/(start_open_cell bottom top).
+  move=> /eqP -> {c}.
+  move/inside_box_left_ptsP/[swap].
+  by rewrite (leftmost_points_max boxwf2)=> ->; rewrite lt_irreflexive.
+move: cov0 evsin0 sval0 btm_left0 leftlim0; move=> {stoevs}.
+elim: evs op0 cl0 => [ | ev evs' Ih]
+   op cl main evsin sval btm_left llim clev oute noc clae rfo adj cbtom sortev.
+  rewrite /= => [][] <- <- p inbox_p.
+  have lexpp : lexePt p p by rewrite lexePt_eqVlt eqxx.
+  by rewrite orbC; apply: (main p isT p inbox_p lexpp).
+rewrite /=.
+case stepeq : (step ev op cl) => [op' cl'].
+move=> scaneq.
+have inbox_e : inside_box bottom top (point ev).
+  by apply: (allP evsin); rewrite map_f // inE eqxx.
+have := sval isT; rewrite /= => sval'.
+have oute' : out_left_event ev by apply: oute; rewrite inE eqxx.
+have btm_left' : bottom_left_cells_lex op (point ev).
+  by apply: btm_left; rewrite inE eqxx.
+have cov : cover_left_of bottom top (point ev) op cl.
+  apply: main=> /=; rewrite lexePt_eqVlt eqxx /=.
+  move: sortev; rewrite /sorted /=.
+  rewrite  (path_sortedE (@lexPt_trans R)) // => /andP[+ _].
+  by apply: sub_all; exact: lexPtW.
+have cov' : forall p : pt,
+    all (lexePt p) [seq point ev0 | ev0 <- evs'] ->
+    cover_left_of bottom top p op' cl'.
+  have := step_keeps_cover sortev cbtom adj inbox_e sval' oute' rfo clae clev
+           noc btm_left' llim stepeq cov.
+  move=> it p; apply: it.
+have evle : forall ev', ev' \in evs' -> lexPt (point ev) (point ev').
+  move=> ev' ev'in.
+  move: sortev=> /=; rewrite (path_sortedE (@lexPt_trans R))=> /andP[]/allP.
+  by move=> /(_ (point ev')) + _; apply; apply map_f.
+have svalr : evs' != [::] ->
+       seq_valid op' (head dummy_pt [seq point ev0 | ev0 <- evs']).
+  case evs'eq : evs' => [// | a q] /= _.
+  have inbox_a : inside_box bottom top (point a).
+    by apply: (allP evsin); rewrite evs'eq !inE eqxx orbT.
+  have eva : lexPt (point ev) (point a).
+    by apply: evle; rewrite evs'eq inE eqxx.
+  have limra : forall e', e' \in evs' -> lexePt (point a) (point e').
+    rewrite evs'eq => e'; rewrite inE => /orP[/eqP -> | e'q ].
+      by rewrite lexePt_eqVlt eqxx.
+    move: sortev=> /=; rewrite evs'eq=> /path_sorted/=; rewrite path_sortedE.
+      by move=>/andP[]/allP/(_ (point e') (map_f (@point _) e'q))/lexPtW.
+    exact: lexPt_trans.
+  have := step_keeps_valid inbox_a inbox_e eva oute' rfo cbtom adj sval' clae
+            clev limra stepeq.
+  by [].
+have btm_leftr:
+   {in [seq point e | e <- evs'], forall e, bottom_left_cells_lex op' e}.
+  have btm_left2 :=
+    step_keeps_left_pts_inf inbox_e oute' rfo sval' adj cbtom clae clev
+           noc btm_left' stepeq.
+  by move=> evp /mapP [ev' ev'in ->]; apply/btm_left2/evle.
+have evsinr : all (inside_box bottom top) [seq point ev' | ev' <- evs'].
+  by move: evsin; rewrite /= => /andP[].
+have clevr : close_edges_from_events bottom top evs'.
+  by move: clev; rewrite /= => /andP[].
+have outer :{in evs', forall ev0 : event, out_left_event ev0}.
+  by move: oute; apply: sub_in1=> x xin; rewrite inE xin orbT.
+have nocr : {in cell_edges op' ++ flatten [seq outgoing i | i <- evs'] &,
+     no_crossing R}.
+  move: noc; apply: sub_in2=> x.
+  rewrite mem_cat=> /orP[].
+    move/(step_sub_open_edges cbtom adj sval' oute' inbox_e stepeq)=> it.
+    by rewrite /= /cell_edges catA -(catA _ _ (outgoing ev)) mem_cat it.
+  by move=> xinf; rewrite /= !mem_cat xinf !orbT.
+have claer : close_alive_edges bottom top op' evs'.
+  by have := step_keeps_closeness inbox_e oute' rfo cbtom adj sval' clev
+      clae stepeq.
+have rfor : s_right_form op'.
+  have noc1: {in  cell_edges op ++ outgoing ev &, no_crossing R}.
+    move: noc; apply sub_in2=> x.
+    rewrite mem_cat=> /orP[it| xino].
+      by rewrite /= /cell_edges catA 2!mem_cat it.
+    by rewrite /= !mem_cat xino !orbT.
+  by apply: (step_keeps_right_form cbtom adj inbox_e sval' noc1 _ _ stepeq).
+have adjr : adjacent_cells op'.
+  by have := step_keeps_adjacent inbox_e oute' sval' cbtom stepeq adj.
+have cbtomr : cells_bottom_top bottom top op'.
+  by apply: (step_keeps_bottom_top inbox_e sval' adj cbtom oute' stepeq).
+have sortev' : sorted (@lexPt R) [seq point x | x <- evs'].
+  by move: sortev; rewrite /= => /path_sorted.
+have llim' : {in op', forall c p, inside_box bottom top p ->
+                  left_limit c = p_x p -> 
+                  contains_point' p c -> has (inside_closed' p) cl'}.
+  by apply: (step_keeps_cover_left_border cbtom
+         adj inbox_e sval' oute' rfo clae
+       clev noc btm_left' stepeq llim).
+by have := Ih _ _ cov' evsinr svalr btm_leftr llim' clevr outer nocr claer
+  rfor adjr cbtomr sortev' scaneq.
+Qed.
+
+Lemma middle_disj_last fc cc lcc lc nos lno:
+ open = fc ++ cc ++ lcc :: lc ->
+  adjacent_cells (fc ++ nos ++ lno :: lc) ->
+  s_right_form  (fc ++ nos ++ lno :: lc)->
+  low (head lno nos) =low (head lcc cc) ->
+  high lno = high lcc ->
+  {in [seq high c | c <- nos], forall g, left_pt g == (point e)} ->
+  {in rcons nos lno &, disjoint_open_cells R} ->
+   {in fc ++ nos ++ lno :: lc &, disjoint_open_cells R}.
+Proof.
+move=> ocd adjn rfon lecnct hecnct lefts ndisj.
+move: pwo=> /= /andP[] _ pwo'.
+have:= disoc adj pwo'.
+Qed.
+
+
+
+Lemma disjoint_open_parts fc cc lcc lc nos lno :
+   open = fc ++ cc ++ lcc :: lc ->
+  close_alive_edges (fc ++ nos ++ lno :: lc) future_events ->
+  low (head lcc cc) <| high lcc ->
+   low (head lcc cc) = low (head lno nos) ->
+   high lcc = high lno ->
+  {in rcons nos lno &, disjoint_open_cells R} ->
+  {in fc ++ nos ++ lno :: lc &, disjoint_open_cells R}.
+Proof.
+move=> ocd clae_new low_high.
+have lfcbot : fc != [::] -> low (head dummy_cell fc) = bottom.
+  move: cbtom; rewrite ocd.
+  by case: (fc) => [// | /= ca ?] /andP[] /andP[] _ /=/eqP.
+have higfc : fc != nil -> high (last dummy_cell fc) = low (head lcc cc).
+  elim/last_ind : (fc) ocd => [// |s c' _] /= ocd.
+  move: adj; rewrite ocd cat_rcons last_rcons =>/adjacent_catW[] _ /=.
+  by case: (cc) => [ | cc0 cc'] /= /andP[] /eqP ->.
+move=> le_cnct.
+move=> he_cnct.
+have adjnew : adjacent_cells (fc ++ nos ++ lno :: lc).
+  rewrite (_ : fc ++ nos ++ lno :: lc = 
+                fc ++ (rcons nos lno) ++ lc);last first.
+    by rewrite -cats1 -!catA.
+  a d m i t.
+have rfnew : s_right_form (fc ++ nos ++ lno :: lc).
+  a d m i t.
+apply: (@middle_disj_last _ cc lcc)=> //.
+
+*)
+End working_environment.
diff --git a/theories/events.v b/theories/events.v
new file mode 100644
index 0000000..7bca54f
--- /dev/null
+++ b/theories/events.v
@@ -0,0 +1,514 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import math_comp_complements.
+Require Import generic_trajectories points_and_edges.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section working_environment.
+
+Variable R : realFieldType.
+
+Notation pt := (pt R).
+Notation edge := (edge R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+
+Notation event := (event R edge).
+Notation point := (point R edge).
+Notation outgoing := (outgoing R edge).
+
+Definition event_eqb (ea eb : event) : bool :=
+  (point ea == point eb :> pt) && (outgoing ea == outgoing eb).
+
+Lemma event_eqP : Equality.axiom event_eqb.
+Proof.
+rewrite /Equality.axiom.
+move => [pta outa] [ptb outb] /=.
+rewrite /event_eqb/=.
+have [/eqP <- | /eqP anb] := boolP (pta == ptb :> pt).
+  have [/eqP <- | /eqP anb] := boolP (outa == outb).
+    by apply: ReflectT.
+  by apply : ReflectF => [][].
+by apply: ReflectF=> [][].
+Qed.
+
+Canonical event_eqType := EqType event (EqMixin event_eqP).
+
+Notation Bevent := (Bevent _ _).
+(* As in insertion sort, the add_event function assumes that event are
+  sorted in evs (lexicographically, first coordinate, then second coordinate
+  of the point.  On the other hand, no effort is made to sort the various
+  edges in each list.  *)
+Fixpoint add_event (p : pt) (e : edge) (inc : bool) (evs : seq event) :
+  seq event :=
+  match evs with
+  | nil => if inc then [:: Bevent p [::]]
+           else [:: Bevent p [:: e]]
+  | ev1 :: evs' =>
+    let p1 := point ev1 in
+    if p == p1 then
+      if inc then Bevent p1 (outgoing ev1) :: evs'
+      else Bevent p1 (e :: outgoing ev1) :: evs' else
+    if p_x p < p_x p1 then
+      if inc then
+        Bevent p [::] :: evs else
+        Bevent p [:: e] :: evs
+    else if (p_x p == p_x p1) && (p_y p < p_y p1) then
+       if inc then
+         Bevent p [::] :: evs else
+         Bevent p [:: e] :: evs else
+    ev1 :: add_event p e inc evs'
+  end.
+
+Lemma add_event_step (p : pt) (e : edge) (inc : bool) (evs : seq event) :
+  add_event p e inc evs =
+  match evs with
+  | nil => if inc then [:: Bevent p [::]]
+           else [:: Bevent p [:: e]]
+  | ev1 :: evs' =>
+    let p1 := point ev1 in
+    if p == p1 then
+      if inc then Bevent p1 (outgoing ev1) :: evs'
+      else Bevent p1 (e :: outgoing ev1) :: evs' else
+    if p_x p < p_x p1 then
+      if inc then
+        Bevent p [::] :: evs else
+        Bevent p [:: e] :: evs
+    else if (p_x p == p_x p1) && (p_y p < p_y p1) then
+       if inc then
+         Bevent p [::] :: evs else
+         Bevent p [:: e] :: evs else
+    ev1 :: add_event p e inc evs'
+  end.
+Proof. by case: evs. Qed.
+
+(* We should be able to prove that the sequence of events produced by
+  edges to events is sorted lexicographically on the coordinates of
+  the points. *)
+Fixpoint edges_to_events (s : seq edge) : seq event :=
+  match s with
+  | nil => nil
+  | e :: s' =>
+    add_event (left_pt e) e false
+      (add_event (right_pt e) e true (edges_to_events s'))
+  end.
+
+Section proof_environment.
+Variable bottom top : edge.
+
+Definition lexPtEv (e1 e2 : event) : bool :=
+  lexPt (point e1) (point e2).
+
+Definition lexePtEv (e1 e2 : event) : bool :=
+  lexePt (point e1) (point e2).
+
+Definition event_close_edge ed ev : bool :=
+right_pt ed == point ev.
+
+Definition end_edge edge events : bool :=
+  has (event_close_edge edge) events.
+
+Definition close_out_from_event ev future : bool :=
+  all (fun edge => end_edge edge future) (outgoing ev).
+
+Fixpoint close_edges_from_events events : bool :=
+  match events with
+  | [::] => true
+  | ev :: future_events => close_out_from_event ev future_events && close_edges_from_events future_events
+  end.
+
+Lemma close_edges_from_events_step events :
+  close_edges_from_events events = match events with
+  | [::] => true
+  | ev :: future_events => close_out_from_event ev future_events && close_edges_from_events future_events
+  end.
+Proof. by case: events. Qed.
+
+Lemma lexPtEv_trans : transitive lexPtEv.
+Proof. by move=> e2 e1 e3; rewrite /lexPtEv; apply: lexPt_trans. Qed.
+
+Lemma lexePtEv_trans : transitive lexePtEv.
+Proof. by move=> e1 e2 e3; rewrite /lexePtEv; apply: lexePt_trans. Qed.
+
+Lemma event_close_edge_on g e:
+  event_close_edge g e -> (point e) === g.
+Proof.  by move=> /eqP <-; apply: right_on_edge. Qed.
+
+Definition out_left_event ev :=
+  {in outgoing ev, forall e, left_pt e == point(ev)}.
+
+Lemma outleft_event_sort e :
+  out_left_event e ->
+  forall ed, ed \in sort (@edge_below R) (outgoing e) -> left_pt ed == point e.
+Proof.
+move=> outleft ed edin; apply: outleft.
+by have <- := perm_mem (permEl (perm_sort (@edge_below _) (outgoing e))).
+Qed.
+
+Lemma close_out_from_event_sort event future :
+  close_out_from_event event future ->
+  all (end_edge^~ future) (sort (@edge_below R) (outgoing event)).
+Proof.
+move/allP=> outP; apply/allP=> x xin; apply outP.
+by have <- := perm_mem (permEl (perm_sort (@edge_below R) (outgoing event))).
+Qed.
+
+Definition events_to_edges := flatten \o (map outgoing).
+
+Lemma events_to_edges_cons e evs :
+  events_to_edges (e :: evs) = outgoing e ++ events_to_edges evs.
+Proof. by []. Qed.
+
+Lemma out_left_event_on e :
+  out_left_event e -> {in outgoing e, forall g, point e === g}.
+Proof.
+move=> outs g gin; rewrite -(eqP (outs _ gin)); apply: left_on_edge.
+Qed.
+
+Lemma sort_edge_below_sorted s :
+  {in s &, @no_crossing _} ->
+  sorted (@edge_below R) (sort (@edge_below R) s).
+Proof.
+move=> noc.
+have /sort_sorted_in : {in s &, total (@edge_below _)}.
+  by move=> x1 x2 x1in x2in; apply/orP/noc.
+by apply; apply: allss.
+Qed.
+
+Lemma sorted_outgoing le he e : 
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e >>> le ->
+  point e <<< he ->
+  out_left_event e ->
+  {in le :: he :: outgoing e &, no_crossing R} ->
+  sorted (@edge_below R) (le :: sort (@edge_below R) (outgoing e)).
+Proof.
+ set ctxt := (le :: he :: _); move=> vl hl above under outs noc.
+have lein : le \in ctxt by rewrite /ctxt inE eqxx.
+have hein : he \in ctxt by rewrite /ctxt !inE eqxx ?orbT.
+have osub : {subset outgoing e <= ctxt}.
+  by move=> g gin; rewrite /ctxt !inE gin ?orbT.
+have [ls us noc''] :=
+   outgoing_conditions above under lein hein vl hl osub noc outs.
+have /sort_sorted_in tmp : {in le :: outgoing e &, total (@edge_below R)}.
+  move=> e1 e2; rewrite !inE =>/orP[/eqP -> |e1in ]/orP[/eqP -> |e2in].
+  - by rewrite edge_below_refl.
+  - by rewrite ls.
+  - by rewrite ls ?orbT.
+  by apply/orP/noc''.
+rewrite /=; case oeq : (sort (@edge_below R) (outgoing e)) => [// | g1 gs] /=.
+rewrite ls; last first.
+  have <- := perm_mem (permEl (perm_sort (@edge_below R) (outgoing e))).
+  by rewrite oeq inE eqxx.
+rewrite -[X in is_true X]/(sorted _ (g1 :: gs)) -oeq tmp //.
+by apply/allP=> x xin /=; apply/orP; right; exact: xin.
+Qed.
+
+Definition events_non_inner (evs : seq event) :=
+  {in evs &,
+    forall ev1 ev2,
+    {in outgoing ev1, forall g, non_inner g (point ev2)}}.
+
+Lemma add_event_preserve_first p e inc ev evs :
+  (0 < size (add_event p e inc (ev :: evs)))%N /\
+  (point (head ev (add_event p e inc (ev :: evs))) = p \/
+   point (head ev (add_event p e inc (ev :: evs))) = point ev).
+Proof.
+rewrite /=.
+case: ev => [p1 o1].
+have [/eqP -> | /eqP pnp1] := boolP(p == p1).
+  by split; case: inc => //=; left.
+have [pltp1 /= | pnltp1] := boolP(p_x p < p_x p1).
+  split.
+    by case: inc.
+  by case:inc; left.
+have [/eqP pxqpx1 /= | pxnpx1 /=] := boolP (p_x p == p_x p1).
+  have [/eqP pyltpy1 /= | pynltpy1 /=] := boolP (p_y p < p_y p1).
+    by case:inc; (split;[ | left]).
+  by split;[ | right].
+by split;[ | right].
+Qed.
+
+Lemma add_event_sort p e inc evs : sorted lexPtEv evs ->
+  sorted lexPtEv (add_event p e inc evs).
+Proof.
+elim: evs => [ | ev1 evs Ih /=].
+  by case: inc.
+move=> path_evs.
+have [/eqP pp1 | /eqP pnp1] := boolP(p == point ev1).
+  case: inc Ih.
+    by case: evs path_evs => [ | ev2 evs'].
+  by case: evs path_evs => [ | ev2 evs'].
+move/path_sorted/Ih: (path_evs) {Ih} => Ih.
+have [ pltp1 | pnltp1] /= := boolP(p_x p < p_x (point ev1)).
+  by case: inc {Ih}=> /=; (apply/andP; split=> //); rewrite /lexPtEv /lexPt /= pltp1.
+have [/eqP pp1 | pnp1'] /= := boolP (p_x p == p_x (point ev1)).
+  have pyneq : p_y p != p_y (point ev1).
+    apply/eqP=> pp1'; case pnp1.
+    move: p (point ev1) {pnp1 Ih pnltp1} pp1 pp1'.
+    by move=> [a b][c d] /= -> ->.
+  have [ pltp1 | pnltp1'] /= := boolP(p_y p < p_y (point ev1)).
+    by case: (inc); rewrite /= path_evs andbT /lexPtEv /lexPt /= pp1 eqxx pltp1 orbT.
+  have p1ltp : p_y (point ev1) < p_y p.
+    by rewrite ltNge le_eqVlt negb_or pyneq pnltp1'.
+  case evseq : evs => [ | [p2 o2] evs2].
+    by case: (inc)=> /=; rewrite /lexPtEv /lexPt /= pp1 eqxx p1ltp orbT.
+  rewrite -evseq.
+  case aeq : (add_event p e inc evs) => [ | e' evs3].
+    have := add_event_preserve_first p e inc
+           (Bevent p2 o2) evs2.
+      by rewrite -evseq aeq => [[]].
+  case: (add_event_preserve_first p e inc
+          (Bevent p2 o2) evs2)=> _.
+  rewrite -evseq aeq /= => [] [eqp | eqp2].
+    apply/andP; split; last by move: Ih; rewrite aeq.
+    by rewrite /lexPtEv /lexPt eqp pp1 eqxx p1ltp orbT.
+  apply/andP; split; last by move: Ih; rewrite aeq.
+  move: path_evs; rewrite evseq /= andbC => /andP[] _.
+  by rewrite /lexPtEv /= eqp2.
+have p1ltp : p_x (point ev1) < p_x p.
+  by rewrite ltNge le_eqVlt negb_or pnp1' pnltp1.
+case evseq : evs => [ | [p2 o2] evs2].
+  by case: (inc)=> /=; rewrite /lexPtEv /lexPt /= p1ltp.
+case aeq : (add_event p e inc evs) => [ | e' evs3].
+  case: (add_event_preserve_first p e inc
+       (Bevent p2 o2) evs2).
+  by rewrite -evseq aeq.
+case: (add_event_preserve_first p e inc
+     (Bevent p2 o2) evs2) => _.
+have path_e'evs3 : path lexPtEv e' evs3 by move: Ih; rewrite aeq.
+rewrite -evseq aeq /= => [][e'p | e'p2]; rewrite path_e'evs3 andbT.
+  by rewrite /lexPtEv /lexPt e'p p1ltp.
+by move: path_evs; rewrite evseq /= andbC /lexPtEv e'p2=> /andP[].
+Qed.
+
+Lemma sorted_edges_to_events s :
+   sorted (@lexPt R) [seq point x | x <- edges_to_events s].
+Proof.
+have /mono_sorted -> : {mono point : x y / lexPtEv x y >-> lexPt x y} by [].
+by elim: s => [ | g s Ih] //=; do 2 apply: add_event_sort.
+Qed.
+
+End proof_environment.
+
+Lemma add_event_preserve_ends p e inc evs ed :
+  end_edge ed evs ->
+  end_edge ed (add_event p e inc evs).
+Proof.
+rewrite /end_edge /=.
+elim: evs => [// | ev evs Ih] /= /orP[|];
+  repeat (case: ifP => _);
+   rewrite /=/event_close_edge /=; try (move=> -> //); rewrite ?orbT //.
+by move=> ?; rewrite Ih ?orbT.
+Qed.
+
+Lemma add_event_inc evs ed :
+  end_edge ed (add_event (right_pt ed) ed true evs).
+Proof.
+elim: evs => [ | ev evs Ih] /=.
+  by rewrite /end_edge /event_close_edge eqxx.
+case: ifP=> [/eqP <- | ].
+  by rewrite /end_edge /= /event_close_edge /= eqxx.
+repeat (case: ifP=> _); rewrite /end_edge/=/event_close_edge ?eqxx //.
+move=> _; move: Ih; rewrite /end_edge/=/event_close_edge => ->.
+by rewrite !orbT.
+Qed.
+
+Lemma close_edges_from_events_inc evs p ed :
+ close_edges_from_events evs ->
+ close_edges_from_events (add_event p ed true evs).
+Proof.
+elim: evs => /= [ // | ev evs Ih /andP [clev clevs]].
+move: Ih=> /(_ clevs) Ih.
+case: ifP=> _ /=; first by rewrite clevs andbT; exact clev.
+case: ifP=> _ /=; first by rewrite clevs andbT; exact clev.
+case: ifP=> _ /=; first by rewrite clevs andbT; exact clev.
+rewrite Ih andbT.
+apply/allP=> ed' edin'.
+move: (allP clev ed' edin').
+by move=> it; rewrite add_event_preserve_ends // /end_edge it.
+Qed.
+
+Lemma add_edge_close_edges_from_events evs ed :
+  close_edges_from_events evs ->
+  close_edges_from_events
+    (add_event (left_pt ed) ed false (add_event (right_pt ed) ed true evs)).
+Proof.
+have no_eq : left_pt ed == right_pt ed = false.
+    by apply/negP=> /eqP abs_eq; have := edge_cond ed; rewrite abs_eq ltxx.
+elim: evs => [/= _ | ev evs Ih].
+  rewrite no_eq edge_cond /=.
+  by rewrite /close_out_from_event /= /end_edge/=/event_close_edge eqxx.
+move=> tmp; rewrite /= in tmp; case/andP: tmp=> [clev clevs].
+move: Ih=> /(_ clevs) Ih.
+have : end_edge ed (add_event (right_pt ed) ed true (ev :: evs)).
+  by apply: add_event_inc.
+rewrite [add_event (right_pt _) _ _ _]add_event_step.
+lazy zeta.
+case: ifP=> [/eqP <- /= | cnd1].
+  rewrite no_eq edge_cond /=.
+  rewrite /close_out_from_event /= /end_edge/=/event_close_edge.
+  rewrite eqxx /= clevs andbT=> _; exact: clev.
+case: ifP=> cnd2 /=.
+  rewrite no_eq edge_cond /=.
+  rewrite /close_out_from_event /= => -> /=; rewrite clevs andbT; exact: clev.
+case: ifP=> cnd3 ended /=.
+  rewrite no_eq edge_cond.
+  rewrite close_edges_from_events_step.
+  apply/andP; split; last by rewrite /= clev clevs.
+  by move: ended; rewrite /= /close_out_from_event /= andbT.
+case: ifP=> cnd4.
+  rewrite close_edges_from_events_step /close_out_from_event/=.
+  rewrite close_edges_from_events_inc ?andbT ?clevs //.
+  apply/andP; split; last first.
+    apply/allP=> x xin.
+    move/allP: clev=> /(_ x xin) closed.
+    by rewrite add_event_preserve_ends ?orbT.
+  by rewrite add_event_inc.
+case: ifP=> cnd5.
+  rewrite close_edges_from_events_step; apply/andP; split.
+    by move: ended; rewrite /= /close_out_from_event /= andbT.
+  rewrite close_edges_from_events_step; apply/andP; split.
+    apply/allP=> x xin; apply: add_event_preserve_ends.
+    by move/allP: clev=> /(_ x xin).
+  by apply: close_edges_from_events_inc.
+case: ifP=> cnd6.
+  rewrite close_edges_from_events_step; apply/andP; split.
+    by move: ended; rewrite /close_out_from_event /= andbT.
+  rewrite close_edges_from_events_step; apply/andP; split.
+    apply/allP=> x xin; apply: add_event_preserve_ends.
+    by move/allP: clev=> /(_ x xin).
+  by apply: close_edges_from_events_inc.
+rewrite close_edges_from_events_step; apply/andP; split.
+  rewrite /close_out_from_event.
+  apply/allP=> x xin.
+  do 2 apply:add_event_preserve_ends.
+  by move/allP: clev; apply.
+by apply: Ih.
+Qed.
+
+Lemma edges_to_events_wf (bottom top : edge)(s : seq edge) :
+  close_edges_from_events (edges_to_events s).
+Proof.
+elim : s => [ // | e s Ih /=].
+by apply: add_edge_close_edges_from_events.
+Qed.
+
+Lemma edges_to_events_no_loss (s : seq edge) :
+  perm_eq s (events_to_edges (edges_to_events s)).
+Proof.
+have add_inc evs p ed:
+  perm_eq (events_to_edges evs)
+    (events_to_edges (add_event p ed true evs)).
+  elim: evs => [/= | ev evs Ih]; first by apply: perm_refl.
+  rewrite /events_to_edges /=.
+  by repeat (case: ifP=> _ //=); rewrite perm_cat2l Ih.
+have add_out evs p ed:
+  perm_eq (ed :: events_to_edges evs)
+     (events_to_edges (add_event p ed false evs)).
+  elim: evs => [/= | ev evs]; first by apply: perm_refl.
+  rewrite /events_to_edges /= => Ih.
+  repeat (case: ifP => //=); move => ? ? ?.
+  rewrite -[ed :: outgoing ev ++ _]/([:: ed] ++ outgoing ev ++ _).
+  by rewrite perm_catCA perm_cat2l Ih.
+elim: s => /= [// | ed s Ih]; rewrite -(perm_cons ed) in Ih.
+apply/(perm_trans Ih)/(perm_trans _ (add_out _ (left_pt ed) _)).
+by rewrite perm_cons; apply: add_inc.
+Qed.
+
+Lemma edges_to_events_no_crossing s :
+  {in s &, no_crossing R} ->
+  {in events_to_edges (edges_to_events s) &, no_crossing R}.
+Proof.
+by apply: sub_in2=> x; rewrite (perm_mem (edges_to_events_no_loss s)).
+Qed.
+
+Lemma out_left_add_event p g b evs:
+    p = (if b then right_pt g else left_pt g) ->
+    {in evs, forall ev, out_left_event ev} ->
+    {in add_event p g b evs, forall ev, out_left_event ev}.
+Proof.
+move=> ->.
+elim: evs => [ | ev evs Ih] acc.
+  move=> /= ev; case:b; rewrite inE => /eqP -> e //=.
+  by rewrite inE => /eqP ->; rewrite eqxx.
+rewrite /=; case: ifP=> [/eqP pev | ] ev'.
+  case bval: (b); rewrite /= inE => /orP[/eqP ev'ev | ev'inevs].
+  - have -> : ev' = ev by rewrite ev'ev; case: (ev).
+    by apply: acc; rewrite inE eqxx.
+  - by apply: acc; rewrite inE ev'inevs orbT.
+  - move=> g2; rewrite ev'ev /= inE=> /orP[/eqP -> | ].
+    * by rewrite -pev bval eqxx.
+    by apply: acc; rewrite inE eqxx.
+  by apply: acc; rewrite inE ev'inevs orbT.
+case: ifP => [athead | later].
+  case bval: (b) => ev2; rewrite inE => /orP[].
+  - by move/eqP=> -> g2.
+  - by apply: acc.
+  - by move/eqP=> -> g2 /=; rewrite inE=> /eqP ->; rewrite eqxx.
+  by apply: acc.
+case: ifP => [athead' | later'].
+  case bval: (b) => ev2; rewrite inE => /orP[].
+  - by move/eqP=> -> g2.
+  - by apply: acc.
+  - by move/eqP=> -> g2 /=; rewrite inE=> /eqP ->; rewrite eqxx.
+  by apply: acc.
+move=> ev2; rewrite inE=> /orP[/eqP -> | ev2intl].
+  by apply: acc; rewrite inE eqxx.
+apply: Ih=> //.
+by move=> ev3 ev3in; apply: acc; rewrite inE ev3in orbT.
+Qed.
+
+Lemma out_left_edges_to_events s:
+  {in edges_to_events s, forall ev, out_left_event ev}.
+Proof.
+elim: s => [// | g s Ih] /=.
+have Ih' := @out_left_add_event (right_pt g) g true _ erefl Ih.
+by have Ih'' := @out_left_add_event (left_pt g) g false _ erefl Ih'.
+Qed.
+
+Lemma add_event_point_subset (s : mem_pred pt) p g b evs :
+  {subset ([seq point ev | ev <- evs] : seq pt) <= s} ->
+  p \in s ->
+  {subset ([seq point ev | ev <- add_event p g b evs] : seq pt) <= s}.
+Proof.
+elim: evs => [ | ev evs Ih].
+  by move=> _ pin /=; case: ifP => /= bval p'; rewrite inE=> /eqP ->.
+move=> cnd pin.
+  have cnd' : {subset ([seq point ev' | ev' <- evs] : seq pt) <= s}.
+  by move=> p' p'in; apply: cnd; rewrite inE p'in orbT.
+have Ih' := Ih cnd' pin; clear Ih.
+have evin : point ev \in s by apply: cnd; rewrite !inE eqxx.
+rewrite /=; (repeat (case: ifP=> _))=> p'; rewrite /= !inE;
+  (repeat(move=>/orP[])); try solve[move=> /eqP -> // | by apply: cnd'].
+apply: Ih'.
+Qed.
+
+Lemma edges_to_events_subset (s : mem_pred pt) (gs : seq edge) :
+  {subset [seq left_pt g | g <- gs] <= s} ->
+  {subset [seq right_pt g | g <- gs] <= s} ->
+  {subset ([seq point ev | ev <- edges_to_events gs] : seq pt) <= s}.
+Proof.
+elim: gs => [// | g gs Ih].
+rewrite /=.
+move=> cndl cndr.
+have cndl' : {subset [seq left_pt g | g <- gs] <= s}.
+  by move=> x xin; apply: cndl; rewrite inE xin orbT.
+have cndr' : {subset [seq right_pt g | g <- gs] <= s}.
+  by move=> x xin; apply: cndr; rewrite inE xin orbT.
+have cndleft : left_pt g \in s by apply: cndl; rewrite inE eqxx.
+have cndright : right_pt g \in s by apply: cndr; rewrite inE eqxx.
+have Ih' := Ih cndl' cndr'; clear Ih.
+by apply: add_event_point_subset;[apply: add_event_point_subset | ].
+Qed.
+
+End working_environment.
diff --git a/theories/math_comp_complements.v b/theories/math_comp_complements.v
new file mode 100644
index 0000000..22303b5
--- /dev/null
+++ b/theories/math_comp_complements.v
@@ -0,0 +1,271 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Fixpoint seq_subst {A : eqType}(l : seq A) (b c : A) : seq A :=
+  match l with
+  | nil => nil
+  | a :: tl =>
+    if a == b then (c :: seq_subst tl b c) else (a :: seq_subst tl b c)
+  end.
+
+Lemma mem_seq_subst {A : eqType} (l : seq A) b c x :
+  x \in (seq_subst l b c) -> (x \in l) || (x == c).
+Proof.
+elim: l => [// | a l Ih].  
+rewrite /=.
+by case: ifP => [] ?; rewrite !inE=> /orP[ | /Ih /orP[] ] ->; rewrite ?orbT.
+Qed.
+  
+Lemma seq_subst_eq0  {A : eqType} (l : seq A) b c :
+  (seq_subst l b c == [::]) = (l == [::]).
+Proof. by case : l => [ | a l] //=; case: ifP. Qed.
+
+Lemma seq_subst_cat {A : eqType} (l1 l2 : seq A) b c : 
+  seq_subst (l1 ++ l2) b c = seq_subst l1 b c ++ seq_subst l2 b c.
+Proof.
+elim: l1 => [ // | a l1 Ih] /=.
+by case: ifP=> [ab | anb]; rewrite Ih.
+Qed.
+
+Lemma last_in_not_nil (A : eqType) (e : A) (s : seq A) :
+s != [::] -> last e s \in s.
+Proof.
+case : s  => [//= | c q  ]  /= _.
+by rewrite mem_last.
+Qed.
+
+Lemma head_in_not_nil (A : eqType) (e : A) (s : seq A) :
+s != [::] -> head e s \in s.
+Proof.
+case : s  => [//= | c q  ]  /= _.
+by rewrite inE eqxx.
+Qed.
+
+Lemma middle_seq_not_nil  (A : eqType) (a b c : seq A) :
+b != [::] ->
+a ++ b ++ c != [::].
+Proof.
+rewrite -size_eq0 => /negP sizebneq0 /=.
+apply  /negP.
+rewrite -size_eq0 !size_cat /= !addn_eq0 .
+apply  /negP /andP => [] /andP .
+move => /andP [] _ /andP [] sizebeq0.
+by rewrite sizebeq0 in sizebneq0.
+Qed.
+
+Lemma rcons_neq0 (A : Type) (z : A) (s : seq A) : (rcons s z) <> nil.
+Proof.
+by case : s.
+Qed.
+
+Lemma head_rcons (A : Type) (d l : A) (s : seq A) :
+    head d (rcons s l) = head l s.
+Proof. by case: s. Qed.
+
+Lemma allcons [T : predArgType]
+  (f : T -> bool) a q' : all f (a :: q') = f a && all f q'.
+Proof.  by []. Qed.
+
+Definition cutlast (T : Type) (s : seq T) :=
+match s with | a :: s => belast a s | [::] => [::] end.
+
+Lemma last_seq2 (T : Type) (def a : T) (s : seq T) :
+   s <> nil -> last def (a :: s) = last def s.
+Proof.
+by case: s => [// | b s] _ /=.
+Qed.
+
+Lemma behead_cutlasteq (T : Type) a (s : seq T) :
+  (1 < size s)%N -> s = head a s :: rcons (cutlast (behead s)) (last a s).
+Proof.
+by case: s => [ | b [ | c s]] //= _; congr (_ :: _); rewrite -lastI.
+Qed.
+
+Lemma cutlast_subset (T : eqType) (s : seq T) : {subset cutlast s <= s}.
+Proof.
+rewrite /cutlast; case: s => [// | a s].
+elim: s a => [ // | b s Ih /=] a e; rewrite inE=> /orP[/eqP -> | ein].
+  by rewrite inE eqxx.
+by rewrite inE Ih ?orbT.
+Qed.
+
+Lemma behead_subset (T : eqType) (s : seq T) : {subset behead s <= s}.
+Proof. by case: s => [ | a s] // e /=; rewrite inE orbC => ->. Qed.
+
+Lemma sorted_catW (T : Type) (r : rel T) s s' :
+ (sorted r (s ++ s')) -> sorted r s && sorted r s'.
+Proof.
+case: s => [// | a s] /=.
+by rewrite cat_path => /andP[] ->; apply: path_sorted.
+Qed.
+
+Lemma sorted_rconsE (T : Type) (leT : rel T) s y:
+  transitive leT -> sorted leT (rcons s y) -> all (leT^~ y) s.
+Proof.
+move=> tr; elim: s=> [ | init s Ih] //=.
+by rewrite (path_sortedE tr) all_rcons => /andP[] /andP[] -> _.
+Qed.
+
+Lemma uniq_map_injective (T T' : eqType) (f : T -> T') (s : seq T) :
+  uniq [seq f x | x <- s] -> {in s &, injective f}.
+Proof.
+elim: s => [ // | a s Ih] /= /andP[fan uns].
+move=> e1 e2; rewrite !inE => /orP[/eqP -> | e1s ] /orP[/eqP -> | e2s] feq //.
+    by move: fan; rewrite feq; case/negP; apply/mapP; exists e2.
+  by move: fan; rewrite -feq; case/negP; apply/mapP; exists e1.
+by apply: Ih.
+Qed.
+
+Lemma mem_seq_split (T : eqType) (x : T) (s : seq T) :
+  x \in s -> exists s1 s2, s = s1 ++ x :: s2.
+Proof.
+by move=> /splitPr [s1 s2]; exists s1, s2.
+Qed.
+
+Section transitivity_proof.
+
+Variables (T : eqType) (r : rel T) (s1 s2 : mem_pred T).
+
+Hypothesis s1tr : {in s1 & &, transitive r}.
+Hypothesis s2tr : {in s2 & &, transitive r}.
+Hypothesis s1s2 : {in s1 & s2, forall x y, r x y && ~~ r y x}.
+
+Lemma two_part_trans : {in predU s1 s2 & &, transitive r}.
+Proof.
+move=> x2 x1 x3 /orP[x2ins1 | x2ins2] /orP[x1ins1 | x1ins2]
+      /orP[x3ins1 | x3ins2];
+  try solve[move=> ?; apply:s1tr=> // |
+            move=> ?; apply: s2tr => // |
+            move=> ? ?; apply: (proj1 (andP (s1s2 _ _))) => //].
+- by move=> r12 r23; move: (s1s2 x2ins1 x1ins2); rewrite r12 andbF.
+- by move=> r12 r23; move: (s1s2 x2ins1 x1ins2); rewrite r12 andbF.
+- by move=> r12 r23; move: (s1s2 x3ins1 x2ins2); rewrite r23 andbF.
+- by move=> r12 r23; move: (s1s2 x3ins1 x2ins2); rewrite r23 andbF.
+Qed.
+
+End transitivity_proof.
+
+Section abstract_subsets_and_partition.
+
+Variable cell : eqType.
+Variable sub : cell -> cell -> Prop.
+Variable exclude : cell -> cell -> Prop.
+
+Variable close : cell -> cell.
+
+Hypothesis excludeC : forall c1 c2, exclude c1 c2 -> exclude c2 c1.
+Hypothesis exclude_sub : 
+  forall c1 c2 c3, exclude c1 c2 -> sub c3 c1 -> exclude c3 c2.
+
+Lemma add_map (s1 : pred cell) (s2 : seq cell) :
+    all (predC s1) s2 ->
+    {in s2, forall c, sub (close c) c} ->
+    {in predU s1 (mem s2) &, forall c1 c2, c1 = c2 \/ exclude c1 c2} ->
+  {in predU s1 (mem [seq close c | c <- s2]) &,
+    forall c1 c2, c1 = c2 \/ exclude c1 c2}.
+Proof.
+have symcase : forall (s : pred cell) (s' : seq cell),
+  all (predC s) s' -> 
+  {in s', forall c, sub (close c) c} ->
+  {in predU s (mem s') &, forall c1 c2, c1 = c2 \/ exclude c1 c2} ->
+  forall c1 c2, s c1 -> c2 \in s' -> exclude c1 (close c2).
+  move=> s s' dif clsub exc c1 c2 sc1 c2s'.
+  apply/excludeC/(exclude_sub _ (clsub _ _)); last by [].
+  have := exc c2 c1; rewrite 2!inE c2s' orbT inE sc1 => /(_ isT isT).
+  by move=> -[abs | //]; have := allP dif _ c2s'; rewrite inE abs sc1.
+move=> s1nots2 clsub oldx g1 g2.
+rewrite inE => /orP[g1old | /mapP[co1 co1in g1c]];
+  rewrite inE =>  /orP[g2old |/mapP[co2 co2in g2c ]].
+- by apply: oldx; rewrite inE ?g1old ?g2old.
+- by right; rewrite g2c; apply: (symcase _ _ s1nots2 clsub oldx).
+- by right; rewrite g1c; apply excludeC; apply: (symcase _ _ s1nots2 clsub oldx).
+have [/eqP co1co2 | co1nco2] := boolP(co1 == co2).
+  by left; rewrite g1c g2c co1co2.
+right; rewrite g1c; apply/(exclude_sub _ (clsub _ _)); last by [].
+rewrite g2c; apply/excludeC/(exclude_sub _ (clsub _ _)); last by [].
+have := oldx co2 co1; rewrite !inE co2in co1in !orbT=> /(_ isT isT).
+by case=> [abs | //]; case/negP: co1nco2; rewrite abs eqxx.
+Qed.
+
+Lemma add_new (s s2 : pred cell) :
+  {in s &, forall c1 c2, c1 = c2 \/ exclude c1 c2} ->
+  {in s & s2, forall c1 c2, exclude c1 c2} ->
+  {in s2 &, forall c1 c2, c1 = c2 \/ exclude c1 c2} ->
+  {in predU s s2 &, forall c1 c2, c1 = c2 \/ exclude c1 c2}.
+Proof.
+move=> oldx bipart newx c1 c2.
+rewrite inE=> /orP[c1old | c1new] /orP[c2old | c2new].
+- by apply: oldx.
+- by right; apply: bipart.
+- by right; apply/excludeC/bipart.
+by apply: newx.
+Qed.
+
+End abstract_subsets_and_partition.
+
+Section subset_tactic.
+
+Lemma all_sub [T : eqType] [p : pred T] [s1 s2 : seq T] :
+  {subset s1 <= s2} -> all p s2 -> all p s1.
+Proof.  by move=> subs as2; apply/allP=> x xin; apply/(allP as2)/subs. Qed.
+
+Lemma subset_consl [T : eqType] (x : T) (s s': seq T) :
+  x \in s' -> {subset s <= s'} -> {subset (x :: s) <= s'}.
+Proof.
+by move=> xin ssub g; rewrite inE=> /orP[/eqP -> // | ]; apply: ssub.
+Qed.
+
+Lemma subset_catl [T : eqType] (s1 s2 s' : seq T) :
+  {subset s1 <= s'} -> {subset s2 <= s'} -> {subset s1 ++ s2 <= s'}.
+Proof.
+move=> s1sub s2sub g; rewrite mem_cat=>/orP[];[apply: s1sub | apply s2sub].
+Qed.
+
+Lemma subset_catrl [T : eqType] [s s1 s2 : seq T] :
+  {subset s <= s1} -> {subset s <= s1 ++ s2}.
+Proof. by move=> ssub g gn; rewrite mem_cat ssub. Qed.
+
+Lemma subset_catrr [T : eqType] [s s1 s2 : seq T] :
+  {subset s <= s2} -> {subset s <= s1 ++ s2}.
+Proof. by move=> ssub g gn; rewrite mem_cat ssub ?orbT. Qed.
+
+Lemma subset_id [T : eqType] [s : seq T] : {subset s <= s}.
+Proof. by move=> x. Qed.
+
+Lemma subset_head [T : eqType] [s1 s2 : seq T] [x : T] :
+  {subset (x :: s1) <= s2} -> head x s1 \in s2.
+Proof. 
+by move=> sub; apply: sub; case: s1=> [ | a ?] /=; rewrite !inE eqxx ?orbT.
+Qed.
+
+End subset_tactic.
+
+Ltac subset_tac :=
+  trivial; 
+  match goal with
+  | |- {subset ?x <= ?x} => apply: subset_id
+  | |- {subset (_ :: _) <= _} => apply: subset_consl; subset_tac
+  | |- {subset (_ ++ _) <= _} => apply: subset_catl; subset_tac
+  | |- {subset _ <= _ ++ _} => 
+     solve[(apply: subset_catrl; subset_tac)] || 
+     (apply: subset_catrr; subset_tac)
+  | |- {subset _ <= _} =>
+    let g := fresh "g" in let gin := fresh "gin" in
+    move=> g gin; rewrite !(mem_cat, inE, cat_rcons);
+    rewrite ?eqxx ?gin ?orbT //; subset_tac
+  | |- is_true (?x \in (?x :: _)) => rewrite inE eqxx; done
+  | |- is_true (head _ (rcons _ _) \in _) => rewrite head_rcons; subset_tac
+  | |- is_true (head _ _ \in _) => apply: subset_head; subset_tac
+  | |- is_true (_ \in (_ :: _)) => rewrite inE; apply/orP; right; subset_tac
+  | |- is_true (_ \in (_ ++ _)) => rewrite mem_cat; apply/orP;
+    (solve [left; subset_tac] || (right; subset_tac))
+  end.
diff --git a/theories/opening_cells.v b/theories/opening_cells.v
new file mode 100644
index 0000000..a1921b1
--- /dev/null
+++ b/theories/opening_cells.v
@@ -0,0 +1,1395 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import math_comp_complements
+  generic_trajectories points_and_edges events cells.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section working_environment.
+
+Variable R : realFieldType.
+
+Notation pt := (pt R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+Notation Bpt := (Bpt R).
+Notation edge := (edge R).
+Notation event := (event R edge).
+Notation point := (point R edge).
+Notation outgoing := (outgoing R edge).
+
+Notation cell := (cell R edge).
+Notation low := (low R edge).
+Notation high := (high R edge).
+Notation left_pts := (left_pts R edge).
+Notation right_pts := (right_pts R edge).
+
+Notation dummy_pt := (dummy_pt R 1).
+Notation dummy_edge := (dummy_edge R).
+Notation dummy_cell := (dummy_cell R 1 edge (@unsafe_Bedge R)).
+
+(*
+Fixpoint opening_cells_aux (p : pt) (out : seq edge) (low_e high_e : edge) 
+  : seq cell * cell :=
+  match out with
+  | [::] =>
+      let op0 := vertical_intersection_point p low_e in
+      let op1 := vertical_intersection_point p high_e in
+      match (op0,op1) with
+      |(None,_) |(_,None)=> ([::], dummy_cell)
+      |(Some(p0),Some(p1)) =>
+        ([::] , Bcell  (no_dup_seq ([:: p1; p; p0])) [::] low_e high_e)
+      end
+  | c::q =>
+    let op0 := vertical_intersection_point p low_e in
+    let (s, nc) := opening_cells_aux p q c high_e in
+    match op0 with
+    | None => ([::], dummy_cell)
+    | Some(p0) =>
+      (Bcell  (no_dup_seq([:: p; p0])) [::] low_e c :: s, nc)
+  end
+end.
+*)
+
+Definition opening_cells_aux :=
+  opening_cells_aux R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y)
+  1 edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
+
+Lemma opening_cells_aux_eqn p out low_e high_e :
+  opening_cells_aux p out low_e high_e =
+  match out with
+  | [::] =>
+      let op0 := vertical_intersection_point p low_e in
+      let op1 := vertical_intersection_point p high_e in
+      match (op0,op1) with
+      |(None,_) |(_,None)=> ([::], dummy_cell)
+      |(Some(p0),Some(p1)) =>
+        ([::] , Bcell _ _ (no_dup_seq ([:: p1; p; p0])) [::] low_e high_e)
+      end
+  | c::q =>
+    let op0 := vertical_intersection_point p low_e in
+    let (s, nc) := opening_cells_aux p q c high_e in
+    match op0 with
+    | None => ([::], dummy_cell)
+    | Some(p0) =>
+      (Bcell _ _ (no_dup_seq([:: p; p0] : seq pt)) [::] low_e c :: s, nc)
+  end
+end.
+Proof.  by case: out. Qed.
+
+Definition opening_cells (p : pt) (out : seq edge) (l h : edge) : seq cell :=
+   let (s, c) := opening_cells_aux p (sort (@edge_below R) out) l h in
+   rcons s c.
+
+Section proof_environment.
+Variables bottom top : edge.
+
+Notation extra_bot := (extra_bot bottom).
+Notation close_alive_edges := (close_alive_edges bottom top).
+Notation cells_bottom_top := (cells_bottom_top bottom top).
+Notation inside_box := (inside_box bottom top).
+Notation open_cell_side_limit_ok := (@open_cell_side_limit_ok R).
+Notation seq_low_high_shift := (@seq_low_high_shift R).
+Notation cover_left_of := (@cover_left_of _ bottom top).
+
+Section opening_cells.
+
+Lemma opening_cells_left p out le he :
+  {in out, forall g, left_pt g == p} ->
+  valid_edge le p ->
+  valid_edge he p ->
+  {in opening_cells p out le he, forall c, left_limit c = p_x p}.
+Proof.
+move=> outl vle vhe; rewrite /opening_cells.
+rewrite /opening_cells_aux.
+have : forall g, g \in sort (@edge_below _) out -> left_pt g == p.
+  by move=> g; rewrite mem_sort; apply: outl.
+elim: (sort _ _) le vle => [ | g1 gs Ih] le vle {}outl c /=.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite /= pvertE // pvertE //=.
+  by case: ifP=> _; case: ifP=> _; rewrite inE /left_limit => /eqP ->.
+have outl' : forall g, g \in gs -> left_pt g == p.
+  by move=> g gin; apply outl; rewrite inE gin orbT.
+rewrite /=.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (outl g1 _)) ?valid_edge_left // inE eqxx.
+move: Ih; case oca_eq : (generic_trajectories.opening_cells_aux _ _ _ _) => [s c'] /(_ _ vg1 outl').
+rewrite oca_eq => Ih.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //=.
+rewrite inE => /orP[/eqP -> | ]; first by rewrite /left_limit; case : ifP.
+by apply: Ih.
+Qed.
+
+Lemma opening_cells_low_diff_high p out le he :
+  {in out, forall g, left_pt g == p} ->
+  uniq out ->
+  valid_edge le p ->
+  valid_edge he p ->
+  p >>> le ->
+  p <<< he ->
+  {in opening_cells p out le he, forall g, low g != high g}.
+Proof.
+move=> outl u vle vhe pal puh; rewrite /opening_cells.
+have {outl} : {in sort (@edge_below _) out, forall g, left_pt g == p}.
+  by move=> g; rewrite mem_sort; apply: outl.
+have {u} : uniq (sort (@edge_below _) out) by rewrite sort_uniq.
+move=> u outl.
+have : le != head he (sort (@edge_below _) out).
+  case: (sort _ _) outl => [ | g1 gs] /=.  
+    move=> _; apply/eqP=> abs; move: puh; rewrite -abs strict_nonAunder// andbC.
+    by rewrite (negbTE pal).
+  move=> /(_ g1 (mem_head _ _)) /eqP lg1q; apply/eqP=> abs.
+  by move: pal; rewrite abs under_onVstrict -lg1q ?valid_edge_left ?left_on_edge.
+elim: (sort _ _) le vle {pal} u outl => [ | g1 gs Ih] le /= vle + + ledif.
+  rewrite /= => _ _.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite (pvertE vle) (pvertE vhe).
+  by case: ifP=> _; case: ifP=> _ /= g; rewrite inE=> /eqP -> /=.
+move=> /andP[] gnin u outl.
+have /eqP lg1q : left_pt g1 == p by apply: outl; rewrite inE eqxx.
+have {}outl : {in gs, forall g, left_pt g == p}.
+  by move=> g gin; apply: outl; rewrite inE gin ?orbT.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite (pvertE vle).
+have vg1 : valid_edge g1 p by rewrite -lg1q valid_edge_left.
+have g1nhe : g1 != he.
+  apply/eqP=> abs.
+  by move: puh; rewrite -abs strict_nonAunder // -lg1q ?left_on_edge.
+have g1dif : g1 != head he gs.
+  apply/eqP=> abs; move: gnin.
+  have : head he gs \in he :: gs.
+    by case: (gs) => [ | ? ?]; rewrite /= !inE !eqxx ?orbT.
+  rewrite -abs inE=> /orP[/eqP {}abs _ | ->]; last by [].
+  by rewrite abs eqxx in g1nhe.
+have := Ih g1 vg1 u outl g1dif; rewrite oca_eq=> {}Ih.
+move=> g; rewrite /= inE=> /orP [/eqP -> /= | ]; first by [].
+apply: Ih.
+Qed.
+
+Lemma opening_cells_seq_edge_shift p s c oe le he :
+  {in oe, forall g, left_pt g == p} ->
+  valid_edge le p -> valid_edge he p ->
+  opening_cells_aux p oe le he = (s, c) ->
+  le :: [seq high i | i <- rcons s c] =
+  rcons [seq low i | i <- rcons s c] he.
+Proof.
+move=> + + vh.
+elim: oe le s c => [ | g1 oe Ih] le s c leftg vl /=.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE // => -[] <- <- /=.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (leftg g1 _)) ?valid_edge_left // inE eqxx.
+have leftg' : {in oe, forall g, left_pt g == p}.
+  by move=> g gin; apply: leftg; rewrite inE gin orbT.
+have := Ih _ _ _ leftg' vg1; case: (opening_cells_aux _ _ _ _)=> [s' c'].
+move=> /(_ s' c' erefl) {}Ih.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+by rewrite pvertE // => -  [] <- <- /=; congr (_ :: _).
+Qed.
+
+Lemma opening_cells_aux_subset c' s' c p s le he:
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  opening_cells_aux p s le he = (s', c') ->
+  c \in rcons s' c' ->
+  (low c \in le :: s) && (high c \in he :: s).
+Proof.
+move=> + vhe.
+elim: s c' s' le => [ | g1 s Ih] c' s' le /= vle lsp.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite pvertE // pvertE // => - [] <- <-.
+  by do 2 (case: ifP=> _); rewrite /= inE=> /eqP -> /=; rewrite !inE !eqxx.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (lsp g1 _)) ?valid_edge_left // inE eqxx.
+have lsp' : {in s, forall g, left_pt g == p}.
+  by move=> g gin; rewrite lsp // inE gin orbT.
+have := Ih _ _ _ vg1 lsp'; case: (opening_cells_aux _ _ _ _)=> [s1 c1].
+move=> /(_ _ _ erefl) {} Ih.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE // => - [] <- <- /=; rewrite inE=> /orP[/eqP -> /= | ].
+  by rewrite !inE ?eqxx ?orbT.
+rewrite inE; move=>/Ih/andP[] ->; rewrite orbT andTb.
+by rewrite !inE orbCA => ->; rewrite orbT.
+Qed.
+
+
+(*TODO : check all uses of opening_cells_aux_subset for potential uses
+  of this simpler lemma. *)
+Lemma opening_cells_subset c p s le he :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  c \in opening_cells p s le he ->
+  (low c \in le :: s) && (high c \in he :: s).
+Proof.
+move=> vle vhe lsp.
+rewrite /opening_cells.
+case oca_eq : (opening_cells_aux _ _ _ _) => [so co] cin.
+have lsp' : {in sort (@edge_below _) s, forall g, left_pt g == p}.
+  by move=> g; rewrite mem_sort; apply: lsp.
+have := opening_cells_aux_subset vle vhe lsp' oca_eq cin.
+by rewrite !inE !mem_sort.
+Qed.
+
+(*
+Lemma opening_cells_aux_nnil p s le he :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  opening_cells_aux p s le he != nil.
+Proof.
+by move=> + vhe; case: s => [ | g1 s] vle lsp; rewrite /= pvertE // ?pvertE.
+Qed.
+*)
+
+Lemma opening_cells_aux_high p s le he :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  [seq high i | i <- (opening_cells_aux p s le he).1] = s.
+Proof.
+move=> vle vhe lsp.
+elim: s le vle lsp => [ | g1 s Ih] le vle lsp.
+  rewrite /= -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite /= pvertE // pvertE.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (lsp g1 _)) ?valid_edge_left // inE eqxx.
+have lsp' : {in s, forall g, left_pt g == p}.
+  by move=> g gin; apply: lsp; rewrite inE gin orbT.
+rewrite /= -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //.
+by have := Ih _ vg1 lsp'; case: (opening_cells_aux _ _ _ _) => [s' c'] /= ->.
+Qed.
+
+Lemma opening_cells_aux_high_last p s le he :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  high (opening_cells_aux p s le he ).2 = he.
+Proof.
+move=> + vhe; elim: s le => [ /= | g1 s Ih] le vle lsp.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (lsp g1 _)) ?valid_edge_left // inE eqxx.
+have lsp' : {in s, forall g, left_pt g == p}.
+  by move=> g gin; apply: lsp; rewrite inE gin orbT.
+have := Ih _ vg1 lsp'.
+rewrite /= -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //.
+by case : (opening_cells_aux _ _ _ _) => [s' c'].
+Qed.
+
+Lemma opening_cells_high p s le he :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  [seq high i | i <- opening_cells p s le he] =
+  rcons (sort (@edge_below R) s) he.
+Proof.
+move=> vle vhe lsp; rewrite /opening_cells.
+have lsp' :
+   {in sort (@edge_below _) s, forall g, left_pt g == p}.
+  move=> g; rewrite mem_sort; apply: lsp.
+move: (lsp') => /opening_cells_aux_high => /(_ _ _ vle vhe).
+move: lsp' => /opening_cells_aux_high_last => /(_ _ _ vle vhe).
+case: (opening_cells_aux _ _ _ _) => [s' c'] /=.
+by rewrite map_rcons => -> ->.
+Qed.
+
+Lemma opening_cells_aux_right_form (ctxt s : seq edge) (p : pt) le he
+ s' c' :
+p >>= le -> p <<< he -> valid_edge le p -> valid_edge he p ->
+le \in ctxt -> he \in ctxt ->
+le <| he -> {in s, forall g, left_pt g == p} ->
+{in ctxt &, (@no_crossing R)} ->
+{subset s <= ctxt} ->
+path (@edge_below R) le s  ->
+opening_cells_aux p s le he = (s', c') ->
+s_right_form (rcons s' c').
+Proof.
+move=> + ph + vh + hin + + noc + +.
+elim: s le s' c' => [ | g1 edges IH] le s' c'
+  pabove vle lin lowhigh outs allin sorted_e /=.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE // => -[] <- <- /=; rewrite andbT.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //.
+have outs' : {in edges, forall g, left_pt g == p}.
+  by move=> g gin; apply outs; rewrite inE gin orbT.
+have allin' : {subset edges <= ctxt}.
+  by move=> g gin; rewrite allin // inE gin orbT.
+have sorted_e' : path (@edge_below R) g1 edges.
+   by apply: (path_sorted sorted_e).
+have /eqP gl : left_pt g1 == p by rewrite outs // inE eqxx.
+have g1belowhigh : g1 <| he.
+  have gin' : g1 \in ctxt by rewrite allin // inE eqxx.
+  have/no_crossingE := noc g1 he gin' hin.
+  by rewrite gl=>/(_ vh)=> -[]/(_ ph).
+have pong : p === g1 by rewrite -gl left_on_edge.
+have paboveg1 : p >>= g1
+   by rewrite strict_nonAunder ?pong //; case/andP: pong.
+move: (sorted_e) => /=/andP[] leg1 _.
+have g1in : g1 \in ctxt by rewrite allin // inE eqxx.
+have vg1 : valid_edge g1 p.
+  by rewrite -(eqP (outs g1 _)) ?valid_edge_left // inE eqxx.
+have := IH g1 _ _ paboveg1 vg1 g1in g1belowhigh outs' allin' sorted_e'.
+case: (opening_cells_aux _ _ _ _) => [s1 c1] - /(_ _ _ erefl) {} IH /=.
+by move=> [] <- <- /=; rewrite leg1.
+Qed.
+
+Lemma opening_cells_right_form p s low_e high_e :
+valid_edge low_e p ->
+valid_edge high_e p ->
+p >>= low_e -> p <<< high_e ->
+low_e <| high_e ->
+{in s, forall g, left_pt g == p} ->
+{in s, forall g, low_e <| g} ->
+{in s, forall g, g <| high_e} ->
+{in s &, (@no_crossing R)} ->
+s_right_form (opening_cells p s low_e high_e).
+Proof.
+move=> vl vh pabove punder lowhigh outs alla allb noc; apply/allP.
+have noc' : {in low_e :: high_e :: s &, (@no_crossing R)}.
+  move=> e1 e2; rewrite !inE !orbA =>/orP[e1lh |e1in ]/orP[e2lh |e2in].
+    by apply/orP;move:e1lh e2lh=> /orP[]/eqP -> /orP[]/eqP ->;
+      rewrite ?edge_below_refl ?lowhigh ?orbT.
+    - by move: e1lh=> /orP[]/eqP ->;apply/orP;
+         rewrite/below_alt ?alla ?allb ?orbT.
+    - by move: e2lh=> /orP[]/eqP ->; apply/orP;
+         rewrite/below_alt ?alla ?allb ?orbT.
+    by apply: noc.
+have sorted_e : sorted (@edge_below R) (sort (@edge_below R) s).
+  by apply: sort_edge_below_sorted.
+have /sub_in1/= trsf : {subset sort (@edge_below R) s <= s}.
+  by move=> x; rewrite mem_sort.
+move/trsf:outs => {}outs.
+have [lin hin] : (low_e \in [:: low_e, high_e & s]) /\
+   (high_e \in [:: low_e, high_e & s]).
+  by split; rewrite !inE eqxx ?orbT.
+have slho : {subset (sort (@edge_below _) s) <=
+               [:: low_e, high_e & s]}.
+  by move=> x; rewrite mem_sort => xin; rewrite !inE xin ?orbT.
+move=> x xin.
+have srt : sorted (@edge_below R) (low_e :: sort (@edge_below R) s).
+  case sq : (sort (@edge_below R) s) => [// | a tl].
+    rewrite -[sorted _ _]/((low_e <| a) && sorted (@edge_below R) (a :: tl)).
+    rewrite -sq sorted_e andbT alla //.
+    by rewrite -(mem_sort (@edge_below _)) sq inE eqxx.
+have := (opening_cells_aux_right_form _ _ _ _ lin hin lowhigh outs).
+move: xin; rewrite /opening_cells.
+case: (opening_cells_aux _ _ _ _) => [s1 c1] xin - /(_ s1 c1).
+move=> /(_ _ _ _ _ _ _ _ erefl) => it.
+by apply: (allP (it _ _ _ _ _ _ _) x xin).
+Qed.
+
+Lemma lower_edge_new_cells e low_e high_e:
+forall new_open_cells,
+valid_edge low_e (point e) ->
+valid_edge high_e (point e) ->
+opening_cells (point e) (outgoing e) low_e high_e = new_open_cells ->
+low (head dummy_cell new_open_cells) = low_e.
+Proof.
+move=> vle vhe.
+rewrite /opening_cells.
+case : (sort (@edge_below R) (outgoing e)) => [/= |/= c q] newop.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE //= => <- /=.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //.
+by case: (opening_cells_aux _ _ _ _) => [s1 c1] /= => <- /=.
+Qed.
+
+Lemma opening_cells_not_nil out le he p :
+  opening_cells p out le he != [::].
+Proof.
+rewrite /opening_cells; case: (opening_cells_aux _ _ _ _) => [s1 c1].
+apply/eqP/rcons_neq0.
+Qed.
+
+Lemma higher_edge_new_cells e low_e high_e:
+out_left_event e ->
+valid_edge low_e (point e) -> valid_edge high_e (point e) ->
+forall new_open_cells,
+opening_cells (point e) (outgoing e) low_e high_e =
+   new_open_cells ->
+high (last dummy_cell new_open_cells) = high_e.
+Proof.
+rewrite /opening_cells.
+move=> /outleft_event_sort outl vle vhe.
+have := opening_cells_aux_high_last vle vhe outl.
+case : (opening_cells_aux _ _ _ _) => [s1 c1] <- ? <-.
+by rewrite last_rcons.
+Qed.
+
+Lemma opening_cells_close event low_e high_e future :
+valid_edge low_e (point event) ->
+valid_edge high_e (point event) ->
+out_left_event event ->
+end_edge_ext bottom top low_e future ->
+end_edge_ext bottom top high_e future ->
+close_out_from_event event future ->
+close_alive_edges (opening_cells (point event) (outgoing event) low_e high_e)
+   future.
+Proof.
+rewrite /opening_cells.
+move=> vle vhe oute A B /close_out_from_event_sort; move: A B.
+have : {in sort (@edge_below _) (outgoing event),
+          forall g, left_pt g == (point event)}.
+  by move=> g; rewrite mem_sort; apply: oute.
+move : low_e vle.
+elim : (sort (@edge_below R) (outgoing event)) => [| g1 q Ih] /= 
+            le vle oute' endl endh.
+  move=> _.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE //= endl endh.
+move => /andP[] endg1 allend.
+have oute1 : {in q, forall g, left_pt g == point event}.
+  by move=> g gin; apply oute'; rewrite inE gin orbT.
+have vg1 : valid_edge g1 (point event).
+  by rewrite -(eqP (oute' g1 _)) ?valid_edge_left // inE eqxx.
+have:= Ih g1 vg1 oute1 (end_edgeW _ _ endg1) endh allend.
+case : (opening_cells_aux _ _ _ _) => [s1 c1] => {}Ih.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+by rewrite pvertE //= endl (end_edgeW _ _ endg1) Ih.
+Qed.
+
+Lemma opening_valid e low_e high_e:
+out_left_event e ->
+valid_edge low_e (point e) ->
+valid_edge high_e (point e) ->
+seq_valid (opening_cells (point e) (outgoing e) low_e high_e) (point e).
+Proof.
+move=> + + vhe.
+rewrite /opening_cells.
+move/outleft_event_sort.
+move : low_e.
+elim : (sort (@edge_below R) (outgoing e)) => [/= | c q IH] low_e outl vle.
+  rewrite /=.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE //= vle vhe.
+rewrite /=.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+rewrite pvertE //.
+have vc : valid_edge c (point e).
+  by rewrite -(eqP (outl c _)) ?valid_edge_left // inE eqxx.
+have outl1 : forall g, g \in q -> left_pt g == point e.
+  by move=> g gin; rewrite outl // inE gin orbT.
+have := IH c outl1 vc.
+case: (opening_cells_aux _ _ _ _) => [s1 c1] {} Ih /=.
+by rewrite vle vc Ih.
+Qed.
+
+Lemma adjacent_opening_aux p s le he news newc :
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  opening_cells_aux p s le he = (news, newc) -> 
+  adjacent_cells (rcons news newc) /\
+   (low (head dummy_cell (rcons news newc)) = le).
+Proof.
+move=> + vhe.
+elim: s le news newc => [ | g s Ih] le news newc /= vle oute.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  by rewrite pvertE // pvertE // => - [] <- <- /=.
+have vg : valid_edge g p.
+  by rewrite -(eqP (oute g _)) ?valid_edge_left // inE eqxx.
+have oute' : {in s, forall g, left_pt g == p}.
+  by move=> g' gin; rewrite oute // inE gin orbT.
+case oca_eq: (opening_cells_aux _ _ _ _) => [s1 c1].
+have := Ih g s1 c1 vg oute' oca_eq => -[] Ih1 Ih2 {Ih}.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite pvertE // => - [] <- <- /=; split;[ | done].
+case: (s1) Ih1 Ih2 => [ | a s'] /=.
+  by move=> _ ->; rewrite eqxx.
+by move=> -> ->; rewrite eqxx.
+Qed.
+
+Lemma adjacent_opening p s le he:
+  valid_edge le p -> valid_edge he p ->
+  {in s, forall g, left_pt g == p} ->
+  adjacent_cells (opening_cells p s le he).
+Proof.
+move=> vle vhe lefts.
+have lefts' : {in sort (@edge_below _) s, forall g, left_pt g == p}.
+  by move=> g; rewrite mem_sort; apply: lefts.
+rewrite /opening_cells; case oca_eq: (opening_cells_aux _ _ _ _) => [so co].
+by have [] := adjacent_opening_aux vle vhe  lefts' oca_eq.
+Qed.
+
+Lemma opening_cells_last_lexePt e low_e high_e c :
+out_left_event e ->
+~~(point e <<< low_e) -> point e <<< high_e ->
+valid_edge low_e (point e)-> valid_edge high_e (point e) ->
+{in  (rcons (low_e::(sort (@edge_below R) (outgoing e))) high_e) &, no_crossing R} ->
+low_e <| high_e ->
+ c \in (opening_cells (point e) (outgoing e) low_e high_e) ->
+ lexePt (last dummy_pt (left_pts c)) (point e).
+Proof.
+rewrite /opening_cells.
+move => /outleft_event_sort outlefte eabl eunh lowv highv.
+elim : (sort (@edge_below R) (outgoing e)) low_e eabl lowv outlefte => [/= | c' q IH] low_e eabl lowv outlefte nc linfh.
+  have := pvertE highv; set high_p := Bpt _ _ => hp.
+  have := pvertE lowv; set low_p := Bpt _ _ => lp.
+  have := intersection_on_edge lp=> [][] poel lx_eq.
+  have := intersection_on_edge hp=> [][] poeh hx_eq.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite lp hp.
+  rewrite lx_eq in hx_eq.
+  have y_ineq := order_below_viz_vertical lowv highv lp hp linfh.
+  rewrite  inE => /eqP ->.
+  case: ifP.
+    rewrite -[pt_eqb R eq_op high_p (point e)]/(high_p == (point e) :> pt).
+    move=> /eqP <-.
+    rewrite -[pt_eqb R eq_op high_p low_p]/(high_p == low_p :> pt).
+    case : ifP => [/eqP <-/=|/= _].
+      by rewrite /lexePt eqxx le_refl orbT .
+    by rewrite /lexePt hx_eq eqxx y_ineq /= orbT.
+  rewrite /lexePt.
+  rewrite -[pt_eqb _ _ _ _]/(high_p == point e :> pt).
+  rewrite -[pt_eqb _ _ _ _]/(point e == low_p :> pt).
+  case : ifP => [/eqP <-/=|/=_ ].
+    by rewrite eqxx le_refl /= orbT.
+  rewrite lx_eq eqxx.
+  have -> : p_y low_p <= p_y (point e).
+    by rewrite leNgt -(strict_under_edge_lower_y lx_eq poel).
+  by rewrite orbT.
+rewrite /= .
+have cin : c' \in c' :: q.
+  by rewrite  inE eqxx.
+have c'v: (valid_edge c' (point e)).
+  apply valid_edge_extremities.
+  by rewrite outlefte // cin.
+have einfc' : ~~ (point e <<< c').
+  apply : onAbove.
+  have := outlefte c' cin => /eqP <-.
+  apply :  left_on_edge.
+have outq: (forall e0 : edge_eqType R, e0 \in q -> left_pt e0 == point e).
+  move => e0 ein.
+  apply outlefte.
+  by rewrite inE ein orbT.
+have c'infh : c' <| high_e.
+  have := nc high_e c'.
+  rewrite /= !inE  !mem_rcons !inE  !eqxx !orbT /= => /(_ isT isT).
+  move=> /below_altC/no_crossingE.
+  have := outlefte c' cin => /eqP ->.
+  rewrite highv eunh => [] /(_ isT) [a _].
+  by apply: a.
+have nc' : {in  (rcons (c'::q) high_e) &, no_crossing R}.
+  move => e1 e2 e1in e2in.
+  apply nc.
+    by rewrite inE e1in orbT.
+  by rewrite inE e2in orbT.
+rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+have := pvertE lowv; set low_p := Bpt _ _ => lp.
+rewrite lp.
+have := intersection_on_edge lp=> [][] poel lx_eq.
+case oca_eq : (opening_cells_aux _ _ _ _) => [so co].
+rewrite -[pt_eqb _ _ (point e) low_p]/(point e == low_p :> pt).
+case : ifP=> [/eqP <-/=|/= _].
+  rewrite inE => /orP  [/eqP -> /=|].
+    by rewrite lexePt_refl.
+  have := IH c' einfc' c'v outq nc' c'infh.
+  by rewrite oca_eq.
+rewrite inE => /orP  [/eqP -> /=|].
+  have : p_y low_p <= p_y (point e).
+    by rewrite leNgt -(strict_under_edge_lower_y lx_eq poel).
+  rewrite /lexePt lx_eq eqxx=> ->.
+  by rewrite orbT.
+have := IH c' einfc' c'v outq nc' c'infh.
+by rewrite oca_eq.
+Qed.
+
+Arguments pt_eqb : simpl never.
+
+Lemma opening_cells_aux_side_limit e s le he s' c':
+  valid_edge le e -> valid_edge he e ->
+  e >>= le -> e <<< he ->
+  {in s, forall g, left_pt g == e} ->
+  opening_cells_aux e s le he = (s', c') ->
+  all open_cell_side_limit_ok (rcons s' c').
+Proof.
+move=> + vh.
+elim : s le s' c'=> [ | g s Ih] le s' c' /= vl above under lg.
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  rewrite -[generic_trajectories.vertical_intersection_point
+             _ _ _ _ _ _ _ _ _ _ _]/(vertical_intersection_point _ _).
+  have := pvertE vl; set p1 := Bpt _ _ => /[dup] vip1 ->.
+  have := pvertE vh; set p2 := Bpt _ _ => /[dup] vip2 ->.
+  rewrite /open_cell_side_limit_ok => -[] <- <- /=.
+  have [v1 on1 x1] : [/\ valid_edge le p1, p1 === le & p_x e = p_x p1].
+    by have [on1 xp] := intersection_on_edge vip1.
+  have [v2 on2 x2] : [/\ valid_edge he p2, p2 === he & p_x e = p_x p2].
+    by have [on2 xp] := intersection_on_edge vip2.
+  have p2ne : p2 != e :> pt.
+    apply/eqP=> A; have := strict_under_edge_lower_y x2 on2.
+    by rewrite under => /esym; rewrite ltNge A lexx.
+  rewrite -[pt_eqb _ _ p2 e]/(p2 == e :> pt).
+  rewrite -[pt_eqb _ _ e p1]/(e == p1 :> pt).
+  rewrite (negbTE p2ne); case: ifP => [p1ise | p1ne] /=;
+    move: on1 on2; rewrite ?(eqP p2ise) -?(eqP p1ise) => on1 on2;
+    rewrite ?eqxx ?on1 ?on2 ?(eqP p2ise) -?(eqP p1ise) -?x1 -?x2
+        ?eqxx ?andbT //=.
+    have euh : e <<= he by apply: underW.
+    rewrite lt_neqAle.
+    have tmp:= (under_edge_lower_y x2 on2).
+    rewrite (eqP p1ise) /p1 /p2 /= in tmp; rewrite -tmp {tmp}.
+    rewrite -/p1 -(eqP p1ise) euh andbT.
+    apply/negP=> A; case/negP: p2ne; rewrite pt_eqE (eqP p1ise) /=.
+    by rewrite (eqP A) !eqxx.
+  rewrite -(strict_under_edge_lower_y x2 on2) under /=.
+  rewrite ltNge le_eqVlt negb_or.
+  rewrite -(strict_under_edge_lower_y x1 on1) above andbT.
+  by apply/negP=> A;case/negbT/negP:p1ne; rewrite pt_eqE -?x1 (eqP A) !eqxx.
+have /eqP lgg : left_pt g == e by apply: lg; rewrite inE eqxx.
+rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+have := pvertE vl; set p1 := Bpt _ _ => /[dup] vip1 ->.
+have [v1 on1 x1] : [/\ valid_edge le p1, p1 === le & p_x e = p_x p1].
+  by have [on1 xp] := intersection_on_edge vip1.
+have eong : e === g by rewrite -(eqP (lg g _)) ?inE ?eqxx // left_on_edge.
+case oca_eq : (opening_cells_aux _ _ _ _) => [so co] [] <- <-.
+rewrite /=; apply/andP; split.
+  rewrite /open_cell_side_limit_ok.
+  rewrite -[pt_eqb _ _ e p1]/(e == p1 :> pt).
+  case: ifP=> [eisp1 | enp1] /=;
+    rewrite -?x1 !eqxx on1 -?(eqP eisp1) ?eong ?andbT //=.
+  rewrite ltNge le_eqVlt negb_or.
+  rewrite -(strict_under_edge_lower_y x1 on1) above andbT.
+  by apply/negP=> A; case/negP: enp1; rewrite pt_eqE (eqP A) x1 ?eqxx.
+apply/allP=> c cintl.
+suff/allP/(_ c cintl) : all open_cell_side_limit_ok (rcons so co) by [].
+apply: (Ih g) => //.
+- by apply: valid_edge_extremities; rewrite lg ?inE ?eqxx.
+- by apply: onAbove.
+by move: lg; apply: sub_in1 => g' gin; rewrite inE gin orbT.
+Qed.
+
+Lemma opening_cells_side_limit e s le he :
+  valid_edge le e -> valid_edge he e ->
+  e >>= le -> e <<< he ->
+  {in s, forall g, left_pt g == e} ->
+  all open_cell_side_limit_ok (opening_cells e s le he).
+Proof.
+move=> vle vhe ea eu lefts.
+have lefts' : {in sort (@edge_below _) s, forall g, left_pt g == e}.
+  by move=> g; rewrite mem_sort; apply: lefts.
+have := opening_cells_aux_side_limit vle vhe ea eu lefts'.
+rewrite /opening_cells.
+case oca_eq : (opening_cells_aux _ _ _ _) => [so co].
+by apply.
+Qed.
+
+Lemma fan_edge_below_trans (s : seq edge) p :
+  {in s, forall g, left_pt g == p} ->
+  {in s & &, transitive (@edge_below R)}.
+Proof.
+move=> lcnd g1 g2 g3 g1in g2in g3in.
+by apply: trans_edge_below_out (eqP (lcnd _ _))(eqP (lcnd _ _))(eqP (lcnd _ _)).
+Qed.
+
+Lemma opening_cells_pairwise' e le he :
+   point e >>> le ->
+   point e <<< he ->
+   out_left_event e ->
+   {in le :: he :: outgoing e &, no_crossing R} ->
+   valid_edge le (point e) ->
+   valid_edge he (point e) ->
+   pairwise (@edge_below _)
+         [seq high x | x <- (opening_cells (point e) (outgoing e) le he)].
+Proof.
+move=> pal puh oute noc vle vhe; rewrite /opening_cells.
+have oute' := outleft_event_sort oute.
+have lein : le \in le :: he :: sort (@edge_below _) (outgoing e) by subset_tac.
+have hein : he \in le :: he :: sort (@edge_below _) (outgoing e) by subset_tac.
+have subo' : {subset sort (@edge_below _) (outgoing e) <=
+   le :: he :: sort (@edge_below _) (outgoing e)} by subset_tac.
+have sub' : (le :: he :: sort (@edge_below _) (outgoing e)) =i (le :: he :: (outgoing e)).
+  by move=> g; rewrite !inE mem_sort.
+have noc' : {in le :: he :: sort (@edge_below _) (outgoing e) &, no_crossing R}.
+  by move=> g1 g2; rewrite !sub'; apply: noc.
+case oca_eq : opening_cells_aux => [s' c].
+rewrite pairwise_map pairwise_rcons -pairwise_map /=.
+have [_ it _]:= outgoing_conditions pal puh lein hein vle vhe subo' noc' oute'.
+have := opening_cells_aux_high vle vhe oute'; rewrite oca_eq /= => highsq.
+ apply/andP; split.
+  rewrite [X in is_true X]
+     (_ : _ = all (fun x => x <| high c) [seq high x | x <- s']); last first.
+    by rewrite all_map.
+  have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq /= => ->.
+  by rewrite highsq; apply/allP.
+rewrite highsq.
+have loc_trans : {in sort (@edge_below _) (outgoing e) & &,
+ transitive (@edge_below _)}.
+  by apply: (@fan_edge_below_trans _ (point e)).
+have /sort_edge_below_sorted : {in outgoing e &, no_crossing _}.
+  by move=> x y xin yin; apply: noc; subset_tac.
+by rewrite (sorted_pairwise_in loc_trans (allss _)).
+Qed.
+
+Lemma opening_cells_contains_point e le he nos:
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e >>> le ->
+  point e <<< he ->
+  out_left_event e ->
+  opening_cells (point e) (outgoing e) le he = nos ->
+  {in nos, forall c, contains_point (point e) c}.
+Proof.
+move=> vle vhe pal puh oute oceq.
+have oute' := outleft_event_sort oute.
+have := opening_cells_aux_subset vle vhe oute'.
+move: oceq; rewrite /opening_cells.
+case oca_eq : (opening_cells_aux _ _ _ _)=> [nos' lno'] <- /(_ _ _ _ erefl).
+move=> main x xin; rewrite contains_pointE.
+move: (main x xin); rewrite !inE=> /andP[] lows highs.
+apply/andP; split.
+  move: lows=> /orP[/eqP -> | /oute'/eqP <-]; first by rewrite underWC.
+  by rewrite left_pt_above.
+move: highs=> /orP[/eqP -> | /oute'/eqP <-]; first by rewrite underW.
+by rewrite left_pt_below.
+Qed.
+
+Lemma opening_cells_last_left_pts e le he :
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  out_left_event e ->
+  outgoing e != nil ->
+  point e <<< he ->
+  left_pts (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e))
+     le he).2
+ = Bpt (p_x (point e)) (pvert_y (point e) he) :: point e :: nil.
+Proof.
+move=> vle vhe oute onn puh.
+have oute' := outleft_event_sort oute.
+have puh' : p_y (point e) < pvert_y (point e) he.
+  by rewrite -strict_under_pvert_y.
+have pdif : Bpt (p_x (point e)) (pvert_y (point e) he) != point e :> pt.
+  rewrite pt_eqE negb_and /=; apply/orP; right; rewrite eq_sym.
+  by move: puh'; rewrite lt_neqAle => /andP[] ->.
+case ogeq : (sort _ (outgoing e)) (mem_sort (@edge_below _) (outgoing e)) =>
+  [ | fog ogs] // .
+  move=> abs; case ogeq' : (outgoing e) onn => [ | f q] //=.
+  by suff : f \in [::];[rewrite in_nil | rewrite abs ogeq' inE eqxx].
+move=> elems.
+have lf : left_pt fog = point e.
+  by move: oute'; rewrite ogeq=> oute2; apply/eqP/oute2; rewrite inE eqxx.
+have vf : valid_edge fog (point e) by rewrite valid_edge_extremities // lf eqxx.
+rewrite opening_cells_aux_eqn.
+rewrite /= pvertE //.
+have : {subset ogs <= outgoing e} by move=> x xin; rewrite -elems inE xin orbT.
+move: (fog) lf vf {ogeq elems}.
+elim : (ogs) le {vle} => [ | f q Ih] //= => le fog1 lfog1 vf1 qsubo.
+  rewrite 
+   -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+  rewrite 
+    -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+  rewrite pvertE // pvertE //=. 
+  rewrite -[pt_eqb _ _ _ (point e)]/(_ == point e :> pt).
+  rewrite (negbTE pdif).
+  have -> : pvert_y (point e) fog1 = p_y (point e).
+     by apply on_pvert; rewrite -lfog1 left_on_edge.
+  rewrite -[pt_eqb _ _ (point e) _]/(point e == _ :> pt).
+  rewrite pt_eqE /= !eqxx /=; congr (_ :: _ :: _); apply/(@eqP [eqType of pt]).
+  by rewrite pt_eqE /= !eqxx.
+case oca_eq: (opening_cells_aux _ _ _ _) => [s c].
+rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+rewrite pvertE //=.
+have lfq : left_pt f = point e.
+  by apply/eqP/oute'; rewrite mem_sort qsubo // inE eqxx.
+have vf : valid_edge f (point e).
+  by apply: valid_edge_extremities; rewrite lfq eqxx.
+have qsub : {subset q <= outgoing e}.
+  by move=> x xin; apply: qsubo; rewrite inE xin orbT.
+by have := Ih le f lfq vf qsub; rewrite oca_eq /=.
+Qed.
+
+Lemma opening_cells_aux_absurd_case e le he (s : seq edge) :
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  s != [::] ->
+  {in s, forall g, left_pt g == point e} ->
+   (opening_cells_aux (point e) (sort (@edge_below _) s) le he).1 != [::].
+Proof.
+move=> vle vhe + outs; case sq : s => [ // | a s'] _.
+case ssq : (sort (@edge_below _) s) => [ | b s2].
+  by suff : a \in [::];[ | rewrite -ssq mem_sort sq inE eqxx].
+rewrite opening_cells_aux_eqn.
+rewrite -sq ssq /= pvertE //.
+by case oca_eq : (opening_cells_aux _ _ _ _).
+Qed.
+
+(* TODO : complain that there is no sort_eq0 lemma with statement
+   (sort r l == [::]) = (l == [::]) *)
+
+Lemma opening_cells_1 e le he:
+  outgoing e != [::] ->
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  out_left_event e ->
+  exists fno nos lno, opening_cells (point e) (outgoing e) le he =
+       fno :: rcons nos lno.
+Proof.
+move=> ogn vle vhe oute.
+rewrite /opening_cells.
+have := opening_cells_aux_absurd_case vle vhe ogn oute.
+set x := (opening_cells_aux _ _ _ _).
+case x => [ [ | fno nos] lno] // _.
+by exists fno, nos, lno.
+Qed.
+
+Lemma opening_cells_in p' s le he :
+  valid_edge le p' -> valid_edge he p' ->
+  {in s, forall g, left_pt g == p'} ->
+  {in opening_cells p' s le he, forall c, p' \in (left_pts c : seq pt)}.
+Proof.
+move=> + vhe outp.
+rewrite /opening_cells.
+have {outp} : {in sort (@edge_below _) s, forall g, left_pt g == p'}.
+  by move=> g; rewrite mem_sort; apply: outp.
+elim: (sort _ _) le => [ | g gs Ih] le.
+  move=> _ /= vle g.
+  rewrite 
+   -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+  rewrite 
+   -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+  rewrite (pvertE vle) (pvertE vhe) !inE => /eqP ->.
+  do 2 rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+  case: ifP=> []; case: ifP=> [] /=.
+        move=> /eqP -> // /eqP <-.
+        by rewrite (@mem_head [eqType of pt]).
+      by rewrite (@mem_head [eqType of pt]).
+    move=> /eqP <-; rewrite (@in_cons [eqType of pt]).
+    by rewrite (@mem_head [eqType of pt]) orbT.
+    (* was by move=> /eqP <-; rewrite !inE eqxx orbT. *)
+  by rewrite (@in_cons [eqType of pt]) (@mem_head [eqType of pt]) orbT.
+move=> outp vl.
+have lgq : left_pt g = p' by apply/eqP; apply: (outp _ (mem_head _ _)).
+have vg : valid_edge g p' by rewrite -lgq valid_edge_left.
+have {}outp : {in gs, forall g, left_pt g == p'}.
+  by move=> g' gin; apply: outp; rewrite inE gin orbT.
+have {}Ih := Ih g outp vg.
+rewrite /=.
+rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+rewrite /= (pvertE vl); case oca_eq : (opening_cells_aux _ _ _ _)=> [nos lno].
+move: Ih; rewrite oca_eq /= => Ih.
+move=> c; rewrite inE=> /orP[/eqP -> /= |]; last by apply: Ih.
+case: ifP; last by rewrite (@mem_head [eqType of pt]).
+rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+by move=> /eqP <-; rewrite (@mem_head [eqType of pt]).
+Qed.
+
+Lemma last_opening_cells_side_char e le he pp nos lno :
+  outgoing e != [::] ->
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e <<< he ->
+  out_left_event e ->
+  opening_cells (point e) (outgoing e) le he = rcons nos lno ->
+  in_safe_side_left pp lno =
+   [&& p_x pp == p_x (point e), p_y (point e) < p_y pp & pp <<< he].
+Proof.
+move=> ogn0 vle vhe puh oute oeq.
+have oute' := outleft_event_sort oute.
+have oca_eq:
+  (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he) =
+ (nos, lno).
+  move: oeq; rewrite /opening_cells; case: (opening_cells_aux _ _ _ _)=> [a b].
+  by move/eqP; rewrite eqseq_rcons=> /andP[] /eqP -> /eqP ->.
+have lnoin : lno \in opening_cells (point e) (outgoing e) le he.
+  by rewrite oeq mem_rcons mem_head.
+rewrite /in_safe_side_left.
+have := opening_cells_left oute vle vhe lnoin=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have highlno : high lno = he.
+  by have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq.
+rewrite highlno [in RHS]andbC.
+have := opening_cells_1 ogn0 vle vhe oute => -[fno [nos' [lno' oeq']]].
+have [nosq lnoq] : nos = fno :: nos' /\ lno = lno'.
+  move: oeq'; rewrite oeq -[fno :: rcons _ _]/(rcons (fno :: _) _) => /eqP.
+  by rewrite eqseq_rcons => /andP[] /eqP -> /eqP ->.
+have llnoq : low lno = high (last fno nos').
+  have := adjacent_opening vle vhe oute; rewrite oeq'.
+  rewrite /= -cats1 cat_path=> /andP[] _ /=.
+  by rewrite andbT lnoq eq_sym=> /eqP.
+have /oute lfnoq : high (last fno nos') \in outgoing e.
+  have := opening_cells_high vle vhe oute; rewrite oeq'.
+  have := size_sort (@edge_below _) (outgoing e).
+(* TODO : should use some lemma here *)
+  rewrite -(mem_sort (@edge_below _)); case: (sort _ _) => [ | w w'] //=.
+    by move=>/eqP; rewrite eq_sym size_eq0 (negbTE ogn0).
+  move=> _ [] <-; rewrite map_rcons=> /eqP.
+  rewrite eqseq_rcons => /andP[] /eqP <- _.
+  by elim/last_ind: (nos') => [ | ? ? _];
+rewrite ?mem_head // last_rcons inE map_rcons mem_rcons mem_head orbT.
+have eonl : point e === low lno by rewrite llnoq -(eqP lfnoq) left_on_edge.
+have ppal : (pp >>> low lno) = (p_y (point e) < p_y pp).
+  have := under_edge_lower_y (eqP samex) eonl => ->.
+  by rewrite -ltNge.
+rewrite ppal.
+have := opening_cells_last_left_pts vle vhe oute ogn0 puh.
+rewrite oca_eq /= => ->.
+have [ppuh /= | ] := boolP (pp <<< he); last by [].
+have [ppae /= | ] := boolP (p_y (point e) < p_y pp); last by [].
+rewrite !(@in_cons [eqType of pt]) !pt_eqE /=.
+have vpphe : valid_edge he pp by rewrite (same_x_valid _ samex).
+rewrite -(same_pvert_y vpphe samex).
+move: ppuh; rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[].
+move=> /negbTE -> _.
+move: ppae; rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
+by rewrite !andbF.
+Qed.
+
+Lemma opening_cells_first_left_pts e le he :
+  valid_edge le (point e) ->
+  outgoing e != nil ->
+  point e >>> le ->
+  left_pts 
+     (head dummy_cell
+     (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e))
+     le he).1)
+ = point e :: Bpt (p_x (point e)) (pvert_y (point e) le) :: nil.
+Proof.
+move=> vle onn pal.
+set W := sort _ _.
+have sgt0 : (0 < size W)%N by rewrite /W size_sort; case : (outgoing e) onn.
+case Wq : W sgt0 => [ // | g1 gs'] _ /=.
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
+rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+rewrite pvertE //=.
+rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+case: ifP=> // samept.
+have := pvert_on vle; rewrite -(eqP samept) => onle.
+have /andP[/eqP pf _] := onle.
+by move: pal; rewrite /point_under_edge underE pf le_eqVlt eqxx.
+Qed.
+
+Lemma first_opening_cells_side_char e le he pp fno nos lno :
+  outgoing e != [::] ->
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e >>> le ->
+  out_left_event e ->
+  opening_cells (point e) (outgoing e) le he = rcons (fno :: nos) lno ->
+  in_safe_side_left pp fno =
+   [&& p_x pp == p_x (point e), p_y pp  < p_y (point e) & pp >>> le].
+Proof.
+move=> ogn0 vle vhe pal oute oeq.
+have oute' := outleft_event_sort oute.
+have oca_eq:
+  (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he) =
+ ((fno :: nos), lno).
+  move: oeq; rewrite /opening_cells; case: (opening_cells_aux _ _ _ _)=> [a b].
+  by move/eqP; rewrite eqseq_rcons=> /andP[] /eqP -> /eqP ->.
+have fnoin : fno \in opening_cells (point e) (outgoing e) le he.
+  by rewrite oeq mem_rcons !inE eqxx orbT.
+rewrite /in_safe_side_left.
+have := opening_cells_left oute vle vhe fnoin=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have lowfno : low fno = le.
+  by rewrite (lower_edge_new_cells vle vhe oeq).
+rewrite lowfno.
+have /oute hfnoq : high fno \in outgoing e.
+  have := opening_cells_high vle vhe oute; rewrite oeq /=.
+  have := size_sort (@edge_below _) (outgoing e).
+(* TODO : should use some lemma here *)
+  rewrite -(mem_sort (@edge_below _)); case: (sort _ _) => [ | w w'] //=.
+    by move=>/eqP; rewrite eq_sym size_eq0 (negbTE ogn0).
+  move=> _ [] <-; rewrite map_rcons=> /eqP.
+  rewrite eqseq_rcons => /andP[] /eqP <- _.
+  by rewrite mem_head.
+have eonh : point e === high fno by rewrite -(eqP hfnoq) left_on_edge.
+have ppue : (pp <<< high fno) = (p_y pp < p_y (point e)).
+  by have := strict_under_edge_lower_y (eqP samex) eonh.
+rewrite ppue.
+have := opening_cells_first_left_pts he vle ogn0 pal.
+rewrite oca_eq /= => ->.
+have [{}ppue /= | ] := boolP (p_y pp < p_y (point e)); last by [].
+have [ppal /= | ] := boolP (pp >>> le); last by [].
+rewrite !(@in_cons [eqType of pt]) !pt_eqE.
+have vpple : valid_edge le pp by rewrite (same_x_valid _ samex).
+rewrite -(same_pvert_y vpple samex).
+move: ppal; rewrite (under_pvert_y vpple) le_eqVlt negb_or=> /andP[].
+move=> /negbTE -> _.
+move: ppue; rewrite lt_neqAle=> /andP[] /negbTE -> _.
+by rewrite !andbF.
+Qed.
+
+Lemma middle_opening_cells_side_char e le he pp fno nos lno :
+  outgoing e != [::] ->
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  out_left_event e ->
+  opening_cells (point e) (outgoing e) le he = rcons (fno :: nos) lno ->
+  ~~ has (in_safe_side_left pp) nos.
+Proof.
+move=> ogn0 vle vhe oute oeq.
+have oute' := outleft_event_sort oute.
+have oca_eq:
+  (opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he) =
+ ((fno :: nos), lno).
+  move: oeq; rewrite /opening_cells; case: (opening_cells_aux _ _ _ _)=> [a b].
+  by move/eqP; rewrite eqseq_rcons=> /andP[] /eqP -> /eqP ->.
+rewrite -all_predC; apply/allP=> c cino /=.
+have cin : c \in opening_cells (point e) (outgoing e) le he.
+  by rewrite oeq mem_rcons !(inE, mem_cat) cino !orbT.
+rewrite /in_safe_side_left.
+have := opening_cells_left oute vle vhe cin=> ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have /oute hc : high c \in outgoing e.
+  have := opening_cells_high vle vhe oute; rewrite oeq /=.
+  have := size_sort (@edge_below _) (outgoing e).
+(* TODO : should use some lemma here *)
+  rewrite -(mem_sort (@edge_below _)); case: (sort _ _) => [ | w w'] //=.
+    by move=>/eqP; rewrite eq_sym size_eq0 (negbTE ogn0).
+  move=> _ [] <-; rewrite map_rcons=> /eqP.
+  rewrite eqseq_rcons => /andP[] /eqP <- _.
+  by rewrite inE map_f ?orbT.
+have /oute lc : low c \in outgoing e.
+  have := opening_cells_high vle vhe oute; rewrite oeq /=.
+  have /= := opening_cells_seq_edge_shift oute' vle vhe oca_eq.
+  move=> [] _ -> /eqP; rewrite eqseq_rcons=> /andP[] /eqP + _.
+  rewrite -(mem_sort (@edge_below _)) => <-.
+  by rewrite map_f // mem_rcons inE cino orbT.
+have eonh : point e === high c by rewrite -(eqP hc) left_on_edge.
+have eonl : point e === low c by rewrite -(eqP lc) left_on_edge.
+have := strict_under_edge_lower_y (eqP samex) eonh=> ->.
+have := under_edge_lower_y (eqP samex) eonl=> ->.
+by rewrite le_eqVlt negb_or -!andbA andbCA; case: (_ < _); rewrite !andbF.
+Qed.
+
+Lemma single_opening_cell_side_char e le he pp :
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e >>> le ->
+  point e <<< he ->
+  outgoing e = [::] ->
+  has (in_safe_side_left pp) (opening_cells (point e) (outgoing e) le he) =
+  ([&& p_x pp == p_x (point e), pp >>> le & p_y pp < p_y (point e)] ||
+   [&& p_x pp == p_x (point e), pp <<< he & p_y (point e) < p_y pp]).
+Proof.
+move=> vle vhe pal puh og0.
+have oute : out_left_event e by move=> g; rewrite og0 in_nil.
+have [ppe | ppne] := eqVneq (pp : pt) (point e).
+  rewrite ppe !lt_irreflexive !andbF.
+  apply /negbTE; rewrite -all_predC; apply/allP=> c cin /=.
+  have einl := opening_cells_in vle vhe oute cin.
+  by rewrite /in_safe_side_left einl !andbF.
+have := opening_cells_left oute vle vhe.
+rewrite og0 /opening_cells /=.
+do 2 rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+rewrite (pvertE vle) (pvertE vhe) /= orbF.
+set c := Bcell _ _ _ _.
+move=> /(_ _ (mem_head _ _)).
+rewrite /in_safe_side_left /= => ->.
+have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+rewrite andbCA.
+have puhy : p_y (point e) < pvert_y (point e) he.
+  by rewrite -(strict_under_pvert_y vhe).
+have paly :  pvert_y (point e) le < p_y (point e).
+  by rewrite ltNge -(under_pvert_y vle).
+do 2 rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
+rewrite !pt_eqE /= eqxx /=.
+move: (puhy); rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
+move: (paly); rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
+have vpple : valid_edge le pp by rewrite (same_x_valid _ samex).
+have vpphe : valid_edge he pp by rewrite (same_x_valid _ samex).
+
+have [ | pa] := lerP (p_y pp) (p_y (point e)); rewrite ?(andbF, orbF).
+  rewrite le_eqVlt => /orP[samey | /[dup] pu ->].
+    by case/negP: ppne; rewrite pt_eqE samex samey.
+  have [ppale | _] := boolP (pp >>> le); last by [].
+  have -> : pp <<< he.
+    rewrite (strict_under_pvert_y vpphe).
+    rewrite (same_pvert_y vpphe samex).
+    by apply: (lt_trans pu); rewrite -(strict_under_pvert_y vhe).
+  rewrite /=.
+  have ppaly :  pvert_y (point e) le < p_y pp.
+    rewrite -(same_pvert_y vpple samex).
+    by rewrite ltNge -(under_pvert_y vpple).
+  rewrite !(@in_cons [eqType of pt]).
+  rewrite (negbTE ppne) !pt_eqE /=.
+  move: ppaly; rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
+  have ppuhy : p_y pp < pvert_y (point e) he.
+    by apply: (lt_trans pu).
+  move: ppuhy; rewrite lt_neqAle => /andP[] /negbTE -> _.
+  by rewrite !andbF.
+move=> {c}.
+rewrite ltNge le_eqVlt pa orbT andbF andbT /=.
+have [ppuhe | _] := boolP (pp <<< he); last by rewrite andbF.
+have ppale : pp >>> le.
+  rewrite (under_pvert_y vpple).
+  rewrite (same_pvert_y vpple samex) -ltNge.
+  by apply: (lt_trans _ pa); rewrite ltNge -(under_pvert_y vle).
+rewrite /=.
+have ppaly :  pvert_y (point e) le < p_y pp.
+  rewrite -(same_pvert_y vpple samex).
+  by rewrite ltNge -(under_pvert_y vpple).
+rewrite !(@in_cons [eqType of pt]) (negbTE ppne) !pt_eqE /=.
+move: ppaly; rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
+have ppuhy : p_y pp < pvert_y (point e) he.
+  rewrite -(same_pvert_y vpphe samex).
+  by rewrite -(strict_under_pvert_y vpphe).
+ move: ppuhy; rewrite lt_neqAle => /andP[] /negbTE -> _.
+by rewrite ppale !andbF.
+Qed.
+
+Lemma opening_cells_aux_uniq (q : pt) l g1 g2 r1 r2:
+  uniq l ->
+  g2 \notin l ->
+  {in l, forall g, left_pt g == q} ->
+  valid_edge g1 q ->
+  valid_edge g2 q ->
+  opening_cells_aux q l g1 g2 = (r1, r2) ->
+  uniq (rcons r1 r2).
+Proof.
+move=> ul g2nin ol v1 v2 oca_eq.
+have lg2 := opening_cells_aux_high_last v1 v2 ol.
+have lg1 := opening_cells_aux_high v1 v2 ol.
+apply: (@map_uniq _ _ high).
+rewrite map_rcons rcons_uniq.
+rewrite oca_eq /= in lg2 lg1.
+by rewrite lg2 lg1 g2nin ul.
+Qed.
+
+(* TODO : move to points_and_edges. *)
+Lemma half_point_valid (g : edge) (p1 p2 : pt) :
+  valid_edge g p1 -> valid_edge g p2 ->
+  valid_edge g (Bpt ((p_x p1 + p_x p2) / 2) ((p_y p1 + p_y p2) / 2)).
+Proof.
+rewrite /valid_edge; move=> /andP[] vp1l vp1r /andP[] vp2l vp2r /=.
+have cst2gt0 : (0 < 2 :> R) by apply: addr_gt0.
+apply/andP; split.
+  rewrite -(ler_pM2r cst2gt0) -mulrA mulVf ?mulr1; last by apply: lt0r_neq0.
+  by rewrite mulrDr !mulr1 lerD.
+rewrite -(ler_pM2r cst2gt0) -mulrA mulVf ?mulr1; last by apply: lt0r_neq0.
+by rewrite mulrDr !mulr1 lerD.
+Qed.
+
+Lemma half_between (x y : R) : x < y -> x < (x + y) / 2 < y.
+Proof.
+move=> xy.
+have cst2gt0 : (0 < 2 :> R) by apply: addr_gt0.
+apply/andP; split.
+  rewrite -(ltr_pM2r cst2gt0) -mulrA mulVf ?mulr1; last by apply: lt0r_neq0.
+  by rewrite mulrDr !mulr1 ler_ltD.
+rewrite -(ltr_pM2r cst2gt0) -mulrA mulVf ?mulr1; last by apply: lt0r_neq0.
+by rewrite mulrDr !mulr1 ltr_leD.
+Qed.
+
+Lemma half_between_edges (g1 g2 : edge) p :
+  valid_edge g1 p -> valid_edge g2 p -> p >>= g1 -> p <<< g2 ->
+  (Bpt (p_x p) ((pvert_y p g1 + pvert_y p g2) / 2)) >>> g1 /\
+  (Bpt (p_x p) ((pvert_y p g1 + pvert_y p g2) / 2)) <<< g2.
+Proof.
+move=> vg1 vg2 pal puh; set p1 := Bpt _ _.
+have samex : p_x p1 == p_x p by rewrite eqxx.
+have v1g1 : valid_edge g1 p1 by rewrite (same_x_valid _ samex).
+have v1g2 : valid_edge g2 p1 by rewrite (same_x_valid _ samex).
+rewrite (under_pvert_y v1g1) (strict_under_pvert_y v1g2) -ltNge; apply/andP.
+apply: half_between.
+have := puh; rewrite (strict_under_pvert_y vg2); apply: le_lt_trans.
+by rewrite leNgt -(strict_under_pvert_y vg1).
+Qed.
+
+Lemma opening_cells_non_empty e le he:
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e >>> le ->
+  point e <<< he ->
+  out_left_event e ->
+  uniq (outgoing e) ->
+  {in [:: le, he & outgoing e] &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in opening_cells (point e) (outgoing e) le he, forall c p,
+     valid_edge (low c) p -> valid_edge (high c) p ->
+     p_x (point e) < p_x p ->
+     exists q, [&& q >>> low (close_cell p c), q <<< high (close_cell p c)&
+                 left_limit (close_cell p c) < p_x q < 
+                 right_limit (close_cell p c)]}.
+Proof.
+move=> vle vhe pal puh oute une noc.
+rewrite /opening_cells.
+have : {subset le :: sort (@edge_below _) (outgoing e) <=
+               [:: le, he & outgoing e]}.
+  move=> g; rewrite inE mem_sort=> /orP[/eqP -> | ]; first by subset_tac.
+  by move=> gin; rewrite !inE gin !orbT.
+have := outleft_event_sort oute.
+have : sorted (@edge_below _) (le :: (sort (@edge_below _) (outgoing e))).
+  by apply: (sorted_outgoing vle vhe _ _ _ (inter_at_ext_no_crossing noc)).
+have : uniq (le :: sort (@edge_below _) (outgoing e)).
+  rewrite /= sort_uniq une andbT.
+  rewrite mem_sort; apply/negP=> /oute /eqP abs.
+  by move: pal; rewrite under_onVstrict // -abs left_on_edge.
+elim: (sort _ _) {-6} (le) vle (underWC pal)=> [ | g1 gs Ih] le' vle' pale'.
+  move=> _ _ _ sub0.
+rewrite opening_cells_aux_eqn.
+  rewrite /= (pvertE vle') (pvertE vhe) /=.
+  set c0 := (X in [:: X])=> ?; rewrite inE => /eqP -> p vlp vhp pxgt.
+  (* point p0 has no guarantee concerning the vertical position. *)
+  set p0 := Bpt ((p_x (point e) + p_x p) / 2) ((p_x (point e) + p_x p) / 2).
+  have vlp0 : valid_edge le' p0 by apply: half_point_valid.
+  set p1 := Bpt (p_x p0)(pvert_y p0 le').
+  have vlp1 : valid_edge le' p1 by apply: half_point_valid.
+  have vhp1 : valid_edge he p1 by apply: half_point_valid.
+  have p1onle' : p1 === le' by apply: (pvert_on vlp0).
+  have hein : he \in [:: le, he & outgoing e] by subset_tac.
+  have le'in : le' \in [:: le, he & outgoing e] by apply: sub0; subset_tac.
+  have ba' : inter_at_ext le' he by apply: noc.
+  have ba : below_alt le' he by apply: (inter_at_ext_no_crossing noc).
+  have le'bhe : le' <| he.
+    by apply: (edge_below_from_point_above ba vle' vhe).
+  have p1uh : p1 <<< he.
+    have p1ule' : p1 <<= le' by rewrite (under_onVstrict vlp1) p1onle'.
+    have : p1 <<= he by apply: (order_edges_viz_point' vlp1).
+    rewrite (under_onVstrict vhp1)=> /orP[p1onhe |]; last by [].
+    case: ba'=> [lqh | ]; first by move: pale'; rewrite lqh puh.
+    move=> /(_ _ p1onle' p1onhe).
+    rewrite !inE=> /orP[] /eqP abs.
+      move: vle'; rewrite /valid_edge=> /andP[] + _; rewrite -abs.
+      rewrite leNgt=> /negP[].
+      by have := half_between pxgt=> /andP[] + _; apply.
+    move: vlp; rewrite /valid_edge=> /andP[] _; rewrite -abs.
+    rewrite leNgt=> /negP[].
+    by have := half_between pxgt=> /andP[] _ +.
+  have p1ale' : p1 >>= le' by rewrite (strict_nonAunder vlp1) p1onle'.
+  have := half_between_edges vlp1 vhp1 p1ale' p1uh.
+  set q := Bpt (p_x p1) ((pvert_y p1 le' + pvert_y p1 he) / 2).
+  move=> []qal quh.  
+  exists q.
+  have [-> -> _] := close_cell_preserve_3sides p c0.
+  rewrite right_limit_close_cell // left_limit_close_cell qal quh.
+  have := half_between pxgt=> /andP[] keepit ->; rewrite andbT /=.
+  rewrite /c0/=.
+  by case: ifP=>[] _; case: ifP=> [] _ /=; rewrite /left_limit /= keepit.
+move=> uns srt out sub /=.
+case oca_eq: opening_cells_aux => [s c].
+rewrite 
+ -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
+   /(vertical_intersection_point _ _).
+rewrite (pvertE vle') /=.
+set c0 := Bcell _ _ _ _ _ _.
+move=> c1; rewrite inE=> /orP[/eqP -> | c1in] p /= vlp vhc pxgt; last first.
+  have lg1 : left_pt g1 = (point e).
+    by have := out _ (mem_head _ _) => /eqP <-.
+  have vg1 : valid_edge g1 (point e) by rewrite -lg1 valid_edge_left.
+  have ag1 : point e >>= g1 by rewrite -lg1 left_pt_above.
+  have out' : forall ed, ed \in gs -> left_pt ed == point e.
+    by move=> ed edin; apply: out; rewrite inE edin orbT.
+  have sub' : {subset g1 :: gs <= [:: le, he & outgoing e]}.
+    by move=> g gin; apply: sub; rewrite inE gin orbT.
+  have c1in' : c1 \in (let (s0, c2) := opening_cells_aux (point e) gs g1 he in
+       rcons s0 c2).
+    by rewrite oca_eq.
+  have srt' : sorted (@edge_below _) (g1 :: gs) by move: srt=> /= /andP[] _.
+  have un' : uniq (g1 :: gs) by move: uns=> /= /andP[].
+  by apply: (Ih g1 vg1 ag1 un' srt' out' sub' _ c1in').
+have [-> -> _] := close_cell_preserve_3sides p c0.
+rewrite right_limit_close_cell // left_limit_close_cell.
+set p0 := Bpt ((p_x (point e) + p_x p) / 2) ((p_x (point e) + p_x p) / 2).
+have vlp0 : valid_edge le' p0 by apply: half_point_valid.
+set p1 := Bpt (p_x p0) (pvert_y p0 le').
+have vlp1 : valid_edge le' p1 by apply: half_point_valid.
+have lg1 : left_pt g1 = point e by apply/eqP/out/mem_head.
+have vg1 : valid_edge g1 (point e) by rewrite -lg1 valid_edge_left.
+have vhp1 : valid_edge g1 p1 by apply: half_point_valid.
+have p1onle' : p1 === le' by apply: (pvert_on vlp0).
+have g1in : g1 \in [:: le, he & outgoing e] by apply: sub; subset_tac.
+have le'in : le' \in [:: le, he & outgoing e] by apply: sub; subset_tac.
+have ba' : inter_at_ext le' g1 by apply: noc.
+have ba : below_alt le' g1 by apply: (inter_at_ext_no_crossing noc).
+have le'bhe : le' <| g1 by move: srt=> /= /andP[].
+have p1ug1 : p1 <<< g1.
+  have p1ule' : p1 <<= le' by rewrite (under_onVstrict vlp1) p1onle'.
+  have : p1 <<= g1.
+    by apply: (order_edges_viz_point' vlp1).
+  rewrite (under_onVstrict vhp1)=> /orP[p1ong1 |]; last by [].
+  case: ba'=> [lqg1 | ]; first by move: uns; rewrite lqg1 /= inE eqxx.
+  move=> /(_ _ p1onle' p1ong1).
+  rewrite !inE=> /orP[] /eqP abs.
+    move: vle'; rewrite /valid_edge=> /andP[] + _; rewrite -abs.
+    rewrite leNgt=> /negP[].
+    by have := half_between pxgt=> /andP[] + _; apply.
+  move: vlp; rewrite /valid_edge=> /andP[] _; rewrite -abs.
+  rewrite leNgt=> /negP[].
+  by have := half_between pxgt=> /andP[] _ +.
+have p1ale' : p1 >>= le' by rewrite (strict_nonAunder vlp1) p1onle'.
+have := half_between_edges vlp1 vhp1 p1ale' p1ug1.
+set q := Bpt (p_x p1) ((pvert_y p1 le' + pvert_y p1 g1) / 2).
+move=> []qal qug1.
+exists q.
+have := half_between pxgt=> /andP[] keepit ->; rewrite andbT /=.
+rewrite /c0/= qal qug1 /=.
+by case: ifP=> [] _ /=; rewrite /left_limit /= keepit.
+Qed.
+
+End opening_cells.
+
+End proof_environment.
+
+End working_environment.
+
diff --git a/theories/points_and_edges.v b/theories/points_and_edges.v
new file mode 100644
index 0000000..2cb6951
--- /dev/null
+++ b/theories/points_and_edges.v
@@ -0,0 +1,2817 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import math_comp_complements.
+Require Import generic_trajectories.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section working_context.
+
+Variable (R : realFieldType).
+
+Definition pt := pt R.
+Notation Bpt := (Bpt R).
+Notation p_x := (generic_trajectories.p_x R).
+Notation p_y := (generic_trajectories.p_y R).
+
+Lemma pt_eqP : Equality.axiom (pt_eqb R eq_op).
+Proof.
+rewrite /Equality.axiom.
+move=> [a_x a_y] [b_x b_y]; rewrite /pt_eqb/=.
+have [/eqP <-|/eqP anb] := boolP(a_x == b_x).
+  have [/eqP <- | /eqP anb] := boolP(a_y == b_y).
+    by apply: ReflectT.
+  by apply : ReflectF => [][].
+by apply: ReflectF=> [][].
+Qed.
+
+Canonical pt_eqType := EqType pt (EqMixin pt_eqP).
+
+Lemma pt_eqE (p1 p2 : pt) :
+   (p1 == p2) = (p_x p1 == p_x p2) && (p_y p1 == p_y p2).
+Proof. by move: p1 p2 => [? ?][? ?]. Qed.
+
+Record edge := Bedge {left_pt : pt; right_pt : pt;
+    _ : p_x left_pt < p_x right_pt}.
+
+Definition edge_eqb (e1 e2 : edge) : bool :=
+   let: Bedge a1 b1 p1 := e1 in
+   let: Bedge a2 b2 p2 := e2 in
+   (a1 == a2) && (b1 == b2).
+
+Lemma edge_cond (e : edge) : p_x (left_pt e) < p_x (right_pt e).
+Proof.  by move: e => [l r c]. Qed.
+
+Lemma edge_eqP : Equality.axiom edge_eqb.
+Proof.
+move=> [a1 b1 p1] [a2 b2 p2] /=.
+have [/eqP a1a2 | /eqP a1na2] := boolP(a1 == a2).
+  have [/eqP b1b2 | /eqP b1nb2] := boolP(b1 == b2).
+     move: p1 p2. rewrite -a1a2 -b1b2 => p1 p2.
+     rewrite (eqtype.bool_irrelevance p1 p2).
+     by apply: ReflectT.
+   by apply: ReflectF=> [][].
+by apply: ReflectF=>[][].
+Qed.
+
+Canonical edge_eqType := EqType edge (EqMixin edge_eqP).
+
+Definition area3 :=
+  area3 R +%R (fun x y => x - y) *%R.
+
+(* returns true if p is under e *)
+Definition point_under_edge :=
+  point_under_edge R le +%R (fun x y => x - y) *%R 1 edge
+  left_pt right_pt.
+
+Definition point_strictly_under_edge :=
+  point_strictly_under_edge R eq_op le +%R (fun x y => x - y) *%R 1 edge
+  left_pt right_pt.
+
+Lemma R_ltb_lt  x y : R_ltb R eq_op le x y = (x < y).
+Proof. by rewrite /R_ltb -lt_neqAle. Qed.
+
+Lemma strictE p e :
+  generic_trajectories.point_strictly_under_edge R eq_op le +%R
+    (fun x y => x - y) *%R 1 edge left_pt right_pt p e =
+  (area3 p (left_pt e) (right_pt e) < 0).
+Proof.
+by rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt subrr.
+Qed.
+
+Lemma underE p e :
+  generic_trajectories.point_under_edge R le +%R
+    (fun x y => x - y) *%R 1 edge left_pt right_pt p e =
+  (area3 p (left_pt e) (right_pt e) <= 0).
+Proof. by rewrite /generic_trajectories.point_under_edge subrr. Qed.
+
+Notation "p '<<=' e" := (point_under_edge p e)( at level 70, no associativity).
+Notation "p '<<<' e" := (point_strictly_under_edge p e)(at level 70, no associativity).
+
+Notation "p '>>=' e" := (~~(point_strictly_under_edge p e))( at level 70, no associativity).
+Notation "p '>>>' e" := (~~(point_under_edge p e))(at level 70, no associativity).
+
+Section ring_sandbox.
+
+Definition R' := (R : Type).
+
+Let mul : R' -> R' -> R' := @GRing.mul _.
+Let add : R' -> R' -> R' := @GRing.add _.
+Let sub : R' -> R' -> R' := (fun x y => x - y).
+Let opp : R' -> R' := @GRing.opp _.
+Let zero : R' := 0.
+Let one : R' := 1.
+
+
+Let R2_theory :=
+   @mk_rt R' zero one add mul sub opp
+    (@eq R')
+    (@add0r R) (@addrC R) (@addrA R) (@mul1r R) (@mulrC R)
+      (@mulrA R) (@mulrDl R) (fun x y : R' => erefl (x - y)) (@addrN R).
+
+Add Ring R2_Ring : R2_theory.
+
+Ltac mc_ring :=
+rewrite ?mxE /= ?(expr0, exprS, mulrS, mulr0n) -?[@GRing.add _]/add
+    -?[@GRing.mul _]/mul
+    -?[@GRing.opp _]/opp -?[1]/one -?[0]/zero;
+match goal with |- @eq ?X _ _ => change X with R' end;
+ring.
+
+Let inv : R' -> R' := @GRing.inv _.
+Let div : R' -> R' -> R' := fun x y => mul x (inv y).
+
+Definition R2_sft : field_theory zero one add mul sub opp div inv (@eq R').
+Proof.
+constructor.
+- exact R2_theory.
+- have // : one <> zero by apply/eqP; rewrite oner_eq0.
+- have // : forall p q : R', div p q = mul p (inv q) by [].
+- have // : forall p : R', p <> zero -> mul (inv p) p = one.
+  by move=> *; apply/mulVf/eqP.
+Qed.
+
+Add Field Qfield : R2_sft.
+
+Ltac mc_field :=
+rewrite ?mxE /= ?(expr0, exprS, mulrS, mulr0n) -?[@GRing.add _]/add
+    -?[@GRing.mul _]/mul -[@GRing.inv _]/inv
+    -?[@GRing.opp _]/opp -?[1]/one -?[0]/zero;
+match goal with |- @eq ?X _ _ => change X with R' end;
+field.
+
+Example field_playground (x y : R' ) : x != 0 -> y != 0 -> (x * y) / (x * y) = 1.
+Proof.
+move=> xn0 yn0; mc_field.
+by split; apply/eqP.
+Qed.
+
+(* returns true if p is under A B *)
+Definition pue_f (a_x a_y b_x b_y c_x c_y : R')  : R' :=
+     b_x * c_y + a_x * b_y + c_x * a_y -
+    b_x * a_y - a_x * c_y - c_x * b_y.
+
+Lemma pue_f_o p_x p_y a_x a_y b_x b_y:  pue_f p_x p_y a_x a_y b_x b_y = - pue_f b_x b_y a_x a_y p_x p_y.
+Proof.
+  rewrite /pue_f.
+  mc_ring.
+Qed.
+
+Lemma pue_f_c p_x p_y a_x a_y b_x b_y:  pue_f p_x p_y a_x a_y b_x b_y =  pue_f b_x b_y p_x p_y a_x a_y.
+Proof.
+  rewrite /pue_f.
+  mc_ring.
+Qed.
+
+Lemma pue_f_inter p_x  a_x a_y b_x b_y :  b_x != a_x -> (pue_f p_x ((p_x - a_x)* ((b_y - a_y)/(b_x - a_x)) + a_y) a_x a_y b_x b_y) == 0.
+Proof.
+rewrite /pue_f.
+rewrite -subr_eq0 => h.
+set slope := (_ / _).
+
+rewrite (mulrDr b_x).
+rewrite (mulrDr a_x).
+rewrite -(orbF (_==0)).
+rewrite -(negbTE   h).
+rewrite -mulf_eq0 .
+rewrite ! ( mulrBl (b_x - a_x), fun x y => mulrDl  x y (b_x - a_x)).
+
+rewrite /slope !mulrA !mulfVK //.
+apply/eqP; mc_ring.
+Qed.
+
+Lemma pue_f_inters p_x p_y a_x a_y b_x b_y  :  b_x != a_x -> p_y = ((p_x - a_x) * ((b_y - a_y) / (b_x - a_x)) + a_y) ->
+pue_f p_x p_y a_x a_y b_x b_y == 0.
+Proof.
+move => h ->.
+by apply pue_f_inter; rewrite h.
+
+
+Qed.
+
+Lemma pue_f_eq p_x p_y a_x a_y :
+pue_f p_x p_y p_x p_y a_x a_y == 0.
+Proof.
+rewrite /pue_f /=.
+
+apply /eqP.
+mc_ring.
+Qed.
+
+Lemma pue_f_two_points p_x p_y a_x a_y :
+pue_f p_x p_y p_x p_y a_x a_y == 0 /\ pue_f p_x p_y a_x a_y p_x p_y == 0 /\
+pue_f p_x p_y a_x a_y a_x a_y == 0.
+Proof.
+split.
+apply pue_f_eq.
+split.
+have := pue_f_c p_x p_y  a_x a_y p_x p_y.
+move => ->.
+apply pue_f_eq.
+have := pue_f_c  a_x a_y  a_x a_y p_x p_y.
+move => <-.
+apply pue_f_eq.
+Qed.
+
+Lemma pue_f_vert p_y a_x a_y b_x b_y :
+ (pue_f a_x a_y b_x b_y b_x p_y) == (b_x - a_x) * (p_y - b_y).
+Proof.
+rewrite /pue_f.
+apply /eqP.
+mc_ring.
+Qed.
+
+Lemma ax4 p_x p_y q_x q_y r_x r_y t_x t_y :
+pue_f t_x t_y q_x q_y r_x r_y + pue_f p_x p_y t_x t_y r_x r_y
++ pue_f p_x p_y q_x q_y t_x t_y == pue_f p_x p_y q_x q_y r_x r_y.
+Proof.
+rewrite /pue_f.
+apply /eqP.
+  mc_ring.
+Qed.
+
+Lemma pue_f_linear l a b c d e f :
+l * pue_f a b c d e f = pue_f a (l*b) c (l*d) e (l*f).
+Proof.
+rewrite /pue_f.
+mc_ring.
+Qed.
+
+Lemma pue_f_on_edge_y a_x a_y b_x b_y m_x m_y :
+pue_f m_x m_y a_x a_y b_x b_y == 0 ->
+(b_x - a_x) * m_y = m_x * (b_y -a_y)- (a_x * b_y - b_x *a_y).
+Proof.
+move => /eqP abmeq0.
+apply /eqP.
+rewrite -subr_eq0.
+apply /eqP.
+rewrite -abmeq0 /pue_f.
+mc_ring.
+Qed.
+
+Lemma pue_f_on_edge a_x a_y b_x b_y c_x c_y d_x d_y m_x m_y :
+pue_f m_x m_y a_x a_y b_x b_y == 0 ->
+(b_x - a_x) * pue_f m_x m_y c_x c_y d_x d_y ==
+(m_x - a_x) * pue_f b_x b_y c_x c_y d_x d_y + (b_x - m_x) * pue_f a_x a_y c_x c_y d_x d_y.
+Proof.
+move => on_ed.
+rewrite pue_f_linear  /pue_f (pue_f_on_edge_y on_ed).
+apply /eqP.
+mc_ring.
+Qed.
+
+Lemma pue_f_triangle_on_edge a_x a_y b_x b_y p_x p_y p'_x p'_y :
+pue_f p'_x p'_y a_x a_y b_x b_y == 0 ->
+(b_x - a_x) * pue_f p'_x p'_y a_x a_y p_x p_y ==
+(p'_x - a_x) * pue_f b_x b_y a_x a_y p_x p_y .
+Proof.
+move=> on_ed.
+rewrite pue_f_linear  /pue_f (pue_f_on_edge_y on_ed).
+apply /eqP.
+mc_ring.
+Qed.
+
+Lemma pue_f_triangle_on_edge' a_x a_y b_x b_y p_x p_y p'_x p'_y :
+pue_f p'_x p'_y a_x a_y b_x b_y == 0 ->
+(b_x - a_x) * pue_f p'_x p'_y p_x p_y b_x b_y ==
+(b_x - p'_x) * pue_f a_x a_y p_x p_y b_x b_y .
+Proof.
+move => on_ed .
+rewrite pue_f_linear /pue_f (pue_f_on_edge_y on_ed).
+apply /eqP.
+mc_ring.
+Qed.
+
+Lemma pue_f_on_edge_same_point a_x a_y b_x b_y p_x p_y p_x' p_y':
+a_x != b_x ->
+pue_f p_x p_y a_x a_y b_x b_y == 0 ->
+pue_f p_x' p_y' a_x a_y b_x b_y == 0 ->
+(p_x == p_x') -> (p_y == p_y').
+Proof.
+move => axnbx puep0 puep'0.
+have pyeq := (pue_f_on_edge_y puep0 ).
+have p'yeq := (pue_f_on_edge_y puep'0 ).
+move=> xxs; have yys : (b_x - a_x) * p_y = (b_x - a_x) * p_y'.
+  by rewrite pyeq (eqP xxs) p'yeq.
+move: (axnbx); rewrite eq_sym -subr_eq0=> bxmax.
+apply/eqP.
+by apply: (mulfI bxmax).
+Qed.
+
+Lemma pue_f_ax5 p_x p_y q_x q_y a_x a_y b_x b_y c_x c_y :
+  pue_f p_x p_y a_x a_y b_x b_y *
+  pue_f p_x p_y q_x q_y c_x c_y +
+  pue_f p_x p_y b_x b_y c_x c_y *
+  pue_f p_x p_y q_x q_y a_x a_y =
+  pue_f p_x p_y a_x a_y c_x c_y *
+  pue_f p_x p_y q_x q_y b_x b_y.
+Proof.
+rewrite /pue_f; mc_ring.
+Qed.
+
+Lemma pue_f_triangle_decompose a_x a_y b_x b_y c_x c_y d_x d_y :
+  pue_f a_x a_y c_x c_y d_x d_y = 0 ->
+  pue_f a_x a_y b_x b_y c_x c_y =
+  pue_f a_x a_y b_x b_y d_x d_y +
+  pue_f b_x b_y c_x c_y d_x d_y.
+Proof.
+move=> online.
+rewrite -(eqP (ax4 _ _ _ _ _ _ d_x d_y)).
+rewrite addrC; congr (_ + _).
+by rewrite addrC pue_f_o pue_f_c online oppr0 add0r -pue_f_c.
+Qed.
+
+Definition mkmx2 (a b c d : R) :=
+  \matrix_(i < 2, j < 2)
+    if (i == ord0) && (j == ord0) then a
+    else if i == ord0 then b
+           else if j == ord0 then c else d.
+
+Definition mkcv2 (a b : R) := \col_(i < 2) if i == ord0 then a else b.
+
+Lemma det_mkmx2 a_x a_y b_x b_y :
+  \det(mkmx2 a_x a_y b_x b_y) = a_x * b_y - a_y * b_x.
+Proof.
+rewrite /mkmx2 (expand_det_row _ ord0) big_ord_recr /= big_ord1 /=.
+by rewrite /cofactor /= expr0 expr1 mulNr !mul1r !det_mx11 !mxE /= mulrN.
+Qed.
+
+Lemma line_intersection a_x a_y b_x b_y c_x c_y d_x d_y :
+  c_x != d_x ->
+  0 < pue_f c_x c_y a_x a_y b_x b_y ->
+  pue_f d_x d_y a_x a_y b_x b_y < 0 ->
+  exists p_x p_y,
+    pue_f p_x p_y a_x a_y b_x b_y = 0 /\
+    pue_f p_x p_y c_x c_y d_x d_y = 0 /\
+    (forall q_x q_y, pue_f q_x q_y a_x a_y b_x b_y = 0 ->
+       pue_f q_x q_y c_x c_y d_x d_y = 0 -> p_x = q_x /\ p_y = q_y).
+Proof.
+move=> cltd cabove cunder.
+set A := a_y - b_y; set B := b_x - a_x; set C := \det(mkmx2 a_x a_y b_x b_y).
+have puef1_id x y : pue_f x y a_x a_y b_x b_y = A * x + B * y + C.
+  by rewrite /A /B /C det_mkmx2 /pue_f; mc_ring.
+set D := c_y - d_y; set E := d_x - c_x; set F := \det(mkmx2 c_x c_y d_x d_y).
+have puef2_id x y : pue_f x y c_x c_y d_x d_y = D * x + E * y + F.
+  by rewrite /D /E /F det_mkmx2 /pue_f; mc_ring.
+set M := mkmx2 A B D E.
+set V1 := mkcv2 (b_x - a_x) (b_y - a_y).
+set V2 := mkcv2 (d_x - c_x) (d_y - c_y).
+have sys_to_mx_eqn :
+  forall x y, (A * x + B * y + C = 0 /\ D * x + E * y + F = 0) <->
+   (M *m mkcv2 x y + mkcv2 C F = 0).
+  move=> x y; split.
+    move=> [eq1 eq2]; apply/matrixP=> i j.
+    rewrite !mxE big_ord_recr /= big_ord1 /= !mxE.
+    by case : j => [ [ | j ] ] //= _; case : i => [ [ | [ | i]]].
+  move/matrixP=> mxq.
+  split.
+    have := mxq (Ordinal (isT : (0 < 2)%N)) (Ordinal (isT : (0 < 1)%N)).
+    by rewrite !mxE big_ord_recr /= big_ord1 /= !mxE.
+  have := mxq (Ordinal (isT : (1 < 2)%N)) (Ordinal (isT : (0 < 1)%N)).
+  by rewrite !mxE big_ord_recr /= big_ord1 /= !mxE.
+set sol := - (M ^-1 *m mkcv2 C F) : 'cV_2.
+have soleq : sol = mkcv2 (sol ord0 ord0) (sol ord_max ord0).
+  apply/matrixP=> [][[ | [ | i]]] // ip [ [ | j]] // jp; rewrite /= !mxE /=;
+    (rewrite (_ : Ordinal jp = ord0); last apply: val_inj=> //).
+    by rewrite (_ : Ordinal ip = ord0); last apply: val_inj.
+  by rewrite (_ : Ordinal ip = ord_max); last apply: val_inj.
+have detm : \det M != 0.
+  have dets : \det M = A * E - D * B.
+    rewrite (expand_det_col _ ord0) big_ord_recr /= big_ord1 !mxE /= /cofactor.
+    by rewrite !det_mx11 /= expr1 expr0 !mulNr !mulrN !mul1r !mxE.
+  have -> : \det M = pue_f d_x d_y a_x a_y b_x b_y -
+                  pue_f c_x c_y a_x a_y b_x b_y.
+    by rewrite dets /pue_f /A /B /D /E; mc_ring.
+  rewrite subr_eq0; apply/eqP=> abs; move: cabove cunder; rewrite abs=> ca cu.
+  by have := lt_trans ca cu; rewrite ltxx.
+have Munit : M \in unitmx by rewrite unitmxE unitfE.
+have solm : M *m sol + mkcv2 C F = 0.
+  rewrite /sol mulmxN mulmxA mulmxV; last by rewrite unitmxE unitfE.
+  by rewrite mul1mx addNr.
+move: (solm); rewrite soleq -sys_to_mx_eqn => [][sol1 sol2].
+exists (sol ord0 ord0), (sol ord_max ord0).
+split; first by rewrite puef1_id.
+split; first by rewrite puef2_id.
+move=> qx qy; rewrite puef1_id puef2_id=> tmp1 tmp2; have := conj tmp1 tmp2.
+rewrite sys_to_mx_eqn addrC => /addr0_eq solmq {tmp1 tmp2}.
+suff/matrixP mq : mkcv2 qx qy = sol.
+  by split; rewrite -?(mq ord0 ord0) -?(mq ord_max ord0) mxE.
+by rewrite /sol -mulmxN solmq mulKmx.
+Qed.
+
+Lemma pue_f_eq_slopes ax ay bx b_y mx my :
+  pue_f mx my ax ay bx b_y =
+   (my - ay) * (bx - ax) - (mx - ax) * (b_y - ay) /\
+  pue_f mx my ax ay bx b_y =
+   -((b_y - my) * (bx - ax) - (bx - mx) * (b_y - ay)).
+Proof.
+split; rewrite /pue_f; mc_ring.
+Qed.
+
+Lemma edge_and_left_vertical_f px py qx qy ax ay :
+  px < ax -> px = qx ->
+  (0 < pue_f px py qx qy ax ay) = (qy < py).
+Proof.
+move=> edge_cond <-.
+rewrite [X in (0 < X)](_ : _ = (ax - px) * (py - qy)); last first.
+  by rewrite /pue_f; mc_ring.
+by rewrite pmulr_rgt0 subr_gt0.
+Qed.
+
+Lemma edge_and_right_vertical_f px py qx qy ax ay :
+  ax < px -> px = qx -> (0 < pue_f px py qx qy ax ay) = (py < qy).
+Proof.
+move=> edge_cond <-.
+rewrite [X in (0 < X)](_ : _ = (px - ax) * (qy - py)); last first.
+  by rewrite /pue_f; mc_ring.
+by rewrite pmulr_rgt0 subr_gt0.
+Qed.
+
+End ring_sandbox.
+
+Lemma area3E a b c : area3 a b c =
+   pue_f (p_x a) (p_y a) (p_x b) (p_y b) (p_x c) (p_y c).
+Proof. by case: a b c=> [a_x a_y] [b_x b_y] [c_x c_y]. Qed.
+
+Lemma area3_opposite a b d:  area3 d a b = - area3 b a d.
+Proof.
+  move: a b d => [ax ay] [b_x b_y] [dx dy]/=.
+  apply :pue_f_o.
+Qed.
+
+Lemma area3_cycle a b d : area3 d a b = area3 b d a.
+Proof.
+  move: a b d => [ax ay] [b_x b_y] [dx dy]/=.
+  apply :pue_f_c.
+Qed.
+
+Lemma area3_vert a b c : (p_x b = p_x c) ->
+area3 a b c == (p_x b - p_x a) * (p_y c - p_y b).
+Proof.
+move: a b c => [ax ay] [b_x b_y] [cx cy]/= <-.
+apply : pue_f_vert.
+Qed.
+
+Lemma ax4_three_triangles p q r t :
+area3 t q r + area3 p t r + area3 p q t
+== area3 p q r.
+Proof.
+move : p q r t => [px py] [q_x q_y] [rx ry] [t_x t_y]/= .
+apply : ax4.
+Qed.
+
+
+Lemma area3_two_points a b :
+area3 a a b == 0 /\ area3 a b a == 0 /\
+area3 a b b == 0.
+Proof.
+move : a b => [ax ay] [b_x b_y] /=.
+apply pue_f_two_points.
+Qed.
+
+Lemma area3_on_edge a b c d m :
+area3 m a b == 0 ->
+(p_x b - p_x a) * area3 m c d ==
+(p_x m - p_x a) * area3 b c d + (p_x b - p_x m) * area3 a c d.
+Proof.
+move : a b c d m => [ax ay] [b_x b_y] [cx cy] [dx dy] [mx my]/=.
+apply pue_f_on_edge.
+Qed.
+
+Lemma area3_on_edge_y a b m :
+area3 m a b == 0 ->
+(p_x b - p_x a) * p_y m = p_x m * (p_y b - p_y a) - (p_x a * p_y b - p_x b * p_y a).
+Proof.
+move : a b m => [ax ay] [b_x b_y]  [mx my]/=.
+apply pue_f_on_edge_y.
+Qed.
+
+Lemma area3_triangle_on_edge a b p p' :
+area3 p' a b == 0 ->
+(p_x b - p_x a) * area3 p' a p ==
+(p_x p' - p_x a) * area3 b a p.
+Proof.
+move : a b p p' => [ax ay] [b_x b_y] [px py] [p'x p'y] /=.
+apply pue_f_triangle_on_edge.
+Qed.
+
+Definition subpoint (p : pt) :=
+  Bpt (p_x p) (p_y p - 1).
+
+Lemma edge_and_left_vertical (p q a : pt) :
+  p_x p < p_x a -> p_x p = p_x q ->
+  (0 < area3 p q a) = (p_y q < p_y p).
+Proof.
+case: p=> [px py]; case: a=> [ax ay]; case: q=> [qx qy] /=.
+by move=> c1 c2; apply edge_and_left_vertical_f.
+Qed.
+
+Lemma edge_and_left_vertical_eq (p q a : pt) :
+  p_x p < p_x a -> p_x p = p_x q ->
+  (area3 p q a == 0) = (p == q).
+Proof.
+move=> edge_cond vert_cond.
+apply/idP/idP; last first.
+  by move/eqP ->; rewrite (area3_two_points q a).1.
+move=> abs; suff : p_y p = p_y q.
+  by move: vert_cond {edge_cond abs}; case: p=> [? ?]; case q=> [? ?]/= <- <-.
+apply: le_anti. rewrite (leNgt (p_y p) (p_y q)).
+rewrite -(edge_and_left_vertical edge_cond vert_cond) (eqP abs).
+have ec' : p_x q < p_x a by rewrite -vert_cond.
+rewrite leNgt -(edge_and_left_vertical ec' (esym vert_cond)).
+by rewrite area3_opposite -area3_cycle (eqP abs) oppr0 ltxx.
+Qed.
+
+Lemma edge_and_right_vertical (p q a : pt) :
+  p_x a < p_x p -> p_x p = p_x q ->
+  (0 < area3 p q a) = (p_y p < p_y q).
+Proof.
+case: p=> [px py]; case: a=> [ax ay]; case: q=> [qx qy] /=.
+by move=> c1 c2; apply: edge_and_right_vertical_f.
+Qed.
+
+Lemma point_sub_right (p a : pt) :
+  (p_x p < p_x a) -> 0 < area3 p (subpoint p) a.
+Proof.
+move=> edge_cond.
+rewrite edge_and_left_vertical //; rewrite /subpoint /= lterBDr cprD.
+by rewrite ltr01.
+Qed.
+
+Lemma underW p e :
+  (p <<< e) ->
+  (p <<= e).
+Proof.
+move=> /andP[] _ it; exact: it.
+Qed.
+
+Lemma underWC p e :
+~~ (p <<= e) -> ~~ (p <<< e).
+Proof. by move/negP=> it; apply/negP=> it'; case: it; apply : underW. Qed.
+
+Definition valid_edge :=
+  generic_trajectories.valid_edge R le edge left_pt right_pt.
+
+Lemma valid_edge_extremities e0 p:
+(left_pt e0 == p) || (right_pt e0 == p) ->
+valid_edge e0 p.
+Proof.
+rewrite /valid_edge/generic_trajectories.valid_edge.
+by move => /orP [/eqP eq |/eqP eq ];
+rewrite -eq lexx ?andbT /= {eq} ltW // ; case : e0 .
+Qed.
+
+Lemma valid_edge_left g : valid_edge g (left_pt g).
+Proof.
+by apply: valid_edge_extremities; rewrite eqxx.
+Qed.
+
+Lemma valid_edge_right g : valid_edge g (right_pt g).
+Proof.
+by apply: valid_edge_extremities; rewrite eqxx orbT.
+Qed.
+
+Definition point_on_edge (p: pt) (e :edge) : bool :=
+  (area3 p (left_pt e) (right_pt e) == 0) && (valid_edge e p).
+
+Notation "p '===' e" := (point_on_edge p e)( at level 70, no associativity).
+
+Definition edge_below (e1 : edge) (e2 : edge) : bool :=
+((left_pt e1 <<= e2) && (right_pt e1 <<= e2))
+|| (~~  (left_pt e2 <<< e1) && ~~ (right_pt e2<<< e1)).
+
+Notation "e1 '<|' e2" := (edge_below e1 e2)( at level 70, no associativity).
+
+Definition below_alt (e1 : edge) (e2 : edge) :=
+  edge_below e1 e2 \/ edge_below e2 e1.
+
+Lemma edge_below_refl e : e <| e.
+Proof.
+apply/orP; left.
+rewrite /point_under_edge 2!underE.
+rewrite (eqP (proj1 (area3_two_points _ _))).
+by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
+Qed.
+
+Lemma below_altC e1 e2 : below_alt e1 e2 <-> below_alt e2 e1.
+Proof. by rewrite /below_alt or_comm. Qed.
+
+Lemma below_altN e1 e2 : below_alt e1 e2 -> ~~(e2 <| e1) -> e1 <| e2.
+Proof. by move=> []// ->. Qed.
+
+Definition inter_at_ext (e1 e2 : edge) :=
+  e1 = e2 \/
+  forall p, p === e1 -> p === e2 -> p \in [:: left_pt e1; right_pt e1].
+
+Definition inter_at_ext' (e1 e2 : edge) :=
+  e1 = e2 \/
+  forall p, p === e2 -> p === e1 -> p \in [:: left_pt e2; right_pt e2].
+
+Lemma inter_at_ext_sym (s : seq edge) :
+  {in s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s &, forall e1 e2, inter_at_ext' e1 e2}.
+Proof.
+move=> cnd e1 e2 e1in e2in; case: (cnd e2 e1 e2in e1in).
+  by move=> ->; left.
+by move=> subcnd; right=> p pe2 pe1; apply: subcnd.
+Qed.
+
+Definition no_crossing := forall e1 e2, below_alt e1 e2.
+
+Definition no_crossing'  : Prop:=
+ forall e e' : edge,
+ valid_edge e (left_pt e') ->
+(left_pt e' <<< e  -> e' <| e)  /\
+(~ (left_pt e' <<= e)  -> e <| e').
+
+Lemma left_on_edge e :
+(left_pt e) === e.
+Proof.
+move : e => [ l r inE].
+rewrite /point_on_edge //=.
+have := area3_two_points l r.
+move => [] ->  _ /=.
+apply  /andP .
+split.
+  by [].
+rewrite /=.
+by apply ltW.
+Qed.
+
+Lemma right_on_edge e :
+(right_pt e) === e.
+Proof.
+move : e => [ l r inE].
+rewrite /point_on_edge //=.
+have := area3_two_points r l.
+move => [] _ [] -> _ /=.
+apply  /andP .
+split.
+  rewrite /=.
+  by apply ltW.
+by [].
+Qed.
+
+Lemma point_on_edge_above low_e high_e a :
+a === high_e ->
+~~ (left_pt high_e <<< low_e) ->
+~~ (right_pt high_e <<< low_e) ->
+~~ (a <<< low_e).
+Proof.
+move : high_e => [lr hr inH] /=.
+rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
+rewrite /point_strictly_under_edge.
+rewrite /generic_trajectories.point_strictly_under_edge subrr.
+rewrite !R_ltb_lt -!leNgt => llrllh llrllrh.
+have diffa : (p_x lr - p_x a) <= 0.
+  by rewrite subr_cp0.
+have diffb : (p_x hr - p_x a) >= 0.
+  by rewrite subr_cp0.
+have difflh : (p_x lr - p_x hr) < 0.
+  by rewrite subr_cp0.
+rewrite -(ler_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_le0 (eqP pf).
+by rewrite addr_ge0 // mulr_ge0 // subr_ge0.
+Qed.
+
+Lemma point_on_edge_above_strict low_e high_e a :
+a === high_e ->
+(left_pt high_e >>> low_e) ->
+(right_pt high_e >>> low_e) ->
+(a >>> low_e).
+Proof.
+move : high_e => [lr hr inH] /=.
+rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
+rewrite /point_under_edge -!ltNge !subrr => llrllh llrllrh.
+have diffa : (p_x lr - p_x a) <= 0.
+  by rewrite subr_cp0.
+have diffb : (p_x hr - p_x a) >= 0.
+  by rewrite subr_cp0.
+have difflh : (p_x lr - p_x hr) < 0.
+  by rewrite subr_cp0.
+rewrite -(ltr_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_lt0 (eqP pf).
+have addr_le_gt0 (x y : R) : 0 <= x -> 0 < y -> 0 < x + y.
+  move=> xge0 ygt0; rewrite -(add0r 0).
+  by apply: ler_ltD.
+move: diffa; rewrite le_eqVlt=> /orP[ | diffa]; last first.
+  rewrite addrC addr_le_gt0 // ?mulr_gt0 ?mulr_ge0 //.
+    by rewrite ltW.
+  by rewrite subr_gt0 -subr_lt0.
+rewrite subr_eq0=> /eqP /[dup] lraq <-; rewrite subrr mul0r add0r.
+by rewrite mulr_gt0 // subr_gt0.
+Qed.
+
+Lemma point_on_edge_under low_e high_e a :
+a === (low_e) ->
+ (left_pt low_e) <<= high_e ->
+ (right_pt low_e) <<= high_e ->
+  a <<= high_e.
+Proof.
+move : low_e => [lr hr inH] /=.
+rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
+rewrite /point_under_edge /generic_trajectories.point_under_edge !subrr=> llrllh llrllrh.
+have diffa : (p_x lr - p_x a) <= 0.
+  by rewrite subr_cp0.
+have diffb : (p_x hr - p_x a) >= 0.
+  by rewrite subr_cp0.
+have difflh : (p_x lr - p_x hr) < 0.
+  by rewrite subr_cp0.
+rewrite -(ler_nM2r difflh 0 _) mul0r mulrC -opprB mulNr (eqP pf) opprD.
+by rewrite addr_ge0 // -mulNr mulr_le0 // oppr_le0 subr_cp0.
+Qed.
+
+Lemma point_on_edge_under_strict high_e low_e a :
+a === low_e ->
+(left_pt low_e <<< high_e) ->
+(right_pt low_e <<< high_e) ->
+(a <<< high_e).
+Proof.
+move : low_e => [lr hr inH] /=.
+rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
+rewrite /point_strictly_under_edge.
+rewrite/generic_trajectories.point_strictly_under_edge.
+rewrite !R_ltb_lt !subrr=> llrllh llrllrh.
+have diffa : (p_x lr - p_x a) <= 0.
+  by rewrite subr_cp0.
+have diffb : (p_x hr - p_x a) >= 0.
+  by rewrite subr_cp0.
+have difflh : (p_x lr - p_x hr) < 0.
+  by rewrite subr_cp0.
+rewrite -(ltr_nM2l difflh 0) mulr0 -opprB mulNr oppr_gt0 (eqP pf).
+have addr_le_lt0 (x y : R) : x <= 0 -> y < 0 -> x + y < 0.
+  move=> xle0 ylt0; rewrite -(add0r 0).
+  by apply: ler_ltD.
+move: diffa; rewrite le_eqVlt=> /orP[ | diffa]; last first.
+  rewrite addrC addr_le_lt0 // ?nmulr_llt0 ?mulr_ge0_le0 //.
+      by rewrite ltW.
+  by rewrite subr_gt0 -subr_lt0.
+rewrite subr_eq0=> /eqP /[dup] lraq <-; rewrite subrr mul0r add0r.
+by rewrite nmulr_llt0 // subr_gt0.
+Qed.
+
+Lemma not_strictly_above' low_e high_e p':
+~~ (left_pt (high_e) <<< low_e) ->
+~~ (right_pt (high_e) <<< low_e) ->
+p' ===  high_e ->  p_x (right_pt (low_e)) = p_x p'  ->
+right_pt (low_e) <<= high_e .
+Proof.
+move : low_e => [ll lr inL] /=.
+move => pablh pabrh poep' eqxp'p.
+have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inL)) eqxp'p .
+have := (point_on_edge_above poep' pablh pabrh ).
+rewrite /point_strictly_under_edge strictE.
+rewrite -area3_cycle -leNgt puefcpp' /point_under_edge underE.
+have inle: (p_x lr - p_x ll) >0.
+  by rewrite subr_cp0.
+rewrite (pmulr_rge0 _ inle) => inp'lr.
+have :=  (ax4_three_triangles lr  (left_pt high_e) (right_pt high_e) p') => /eqP <-.
+move : poep'.
+rewrite /point_on_edge=> /andP [] /eqP pue0 valp'.
+rewrite pue0.
+have := (area3_vert (right_pt high_e) eqxp'p  ).
+rewrite -area3_cycle eqxp'p => /eqP ->.
+move : valp'.
+rewrite /valid_edge => /andP [] xlhp' xrhp'.
+have xrhp'0: p_x p' - p_x (right_pt high_e) <=0.
+  by rewrite subr_cp0.
+rewrite add0r.
+rewrite -oppr_ge0 opprD /= addr_ge0//.
+  by rewrite -mulNr mulr_ge0 // oppr_ge0.
+have := (area3_vert (left_pt high_e) eqxp'p  ).
+rewrite -area3_opposite area3_cycle eqxp'p => /eqP ->.
+have xlhp'0: p_x p' - p_x (left_pt high_e) >= 0.
+  by rewrite subr_cp0.
+by rewrite  mulr_ge0.
+Qed.
+
+Lemma under_above_on e p :
+  valid_edge e p -> p <<= e -> p >>= e -> p === e.
+Proof.
+move=> v u a; apply/andP; split => //.
+apply/eqP/le_anti/andP;split.
+  by move: u; rewrite /point_under_edge/generic_trajectories.point_under_edge!subrr.
+move: a; rewrite /point_strictly_under_edge.
+rewrite /generic_trajectories.point_strictly_under_edge subrr.
+by rewrite R_ltb_lt leNgt=> it; exact: it.
+Qed.
+
+(* returns the point of the intersection between a vertical edge
+ intersecting p and the edge e if it exists, None if it doesn't *)
+
+Definition vertical_intersection_point (p : pt) (e : edge) : option pt :=
+  vertical_intersection_point R le +%R (fun x y => x - y) *%R
+    (fun x y => x / y) edge left_pt right_pt p e.
+
+Lemma vertical_none p e :
+  ~~ valid_edge e p -> vertical_intersection_point p e = None.
+Proof.
+move: p e => [px py] [[ax ay] [b_x b_y] ab] h /=.
+rewrite /vertical_intersection_point.
+rewrite /generic_trajectories.vertical_intersection_point /=.
+by rewrite /valid_edge in h; rewrite (negbTE h).
+Qed.
+
+
+Lemma vertical_correct p e :
+    match (vertical_intersection_point p e) with
+  None => ~~ valid_edge e p | Some(i) => i === e end.
+Proof.
+move: p e => [ptx pty] [[ax ay] [bx b_y]  /=ab] .
+rewrite /vertical_intersection_point/valid_edge.
+rewrite /generic_trajectories.vertical_intersection_point.
+case : ifP => /= h ; last first.
+by [].
+have: ax != bx.
+rewrite neq_lt ab //=.
+rewrite /area3.
+set py := ((b_y - ay) / (bx - ax) * ptx + (ay - (b_y - ay) / (bx - ax) * ax)).
+move => h2.
+rewrite /point_on_edge .
+apply /andP.
+split; last first.
+exact h.
+apply pue_f_inters.
+by apply /eqP /nesym /eqP .
+by [].
+Qed.
+
+
+
+Lemma exists_point_valid e p :
+(valid_edge e p) ->
+exists p', vertical_intersection_point p e = Some (p').
+Proof.
+have := vertical_correct p e.
+case : (vertical_intersection_point p e)=> [vp |//=].
+  rewrite /point_on_edge.
+  move => a b.
+  by exists vp.
+move => a b.
+exists p.
+by rewrite b in a.
+Qed.
+
+Lemma intersection_on_edge e p p' :
+vertical_intersection_point p e = Some (p') ->
+p'=== e /\ p_x p = p_x p'.
+Proof.
+have := vertical_correct p e.
+case vert : (vertical_intersection_point p e)=> [vp |//=].
+move: vert.
+rewrite /vertical_intersection_point.
+rewrite /generic_trajectories.vertical_intersection_point.
+case : (generic_trajectories.valid_edge _ _ _ _ _ e p) => [| //].
+move => [] /= vpq  poe [].
+move => <-.
+by rewrite poe -vpq /=.
+Qed.
+
+Lemma not_strictly_under' low_e high_e p' :
+(left_pt (low_e)) <<= (high_e) ->
+(right_pt (low_e))<<= (high_e) ->
+(* This is an alternative way to say
+  valid_edge low_e (right_pt high_e) *)
+p' === low_e ->  p_x (right_pt (high_e)) = p_x p'  ->
+~~ (right_pt (high_e) <<< low_e).
+Proof.
+move : high_e => [hl hr inH] /=.
+move => pablh pabrh poep' eqxp'p.
+have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inH)) eqxp'p .
+have := (point_on_edge_under poep' pablh pabrh ).
+rewrite /point_under_edge/point_strictly_under_edge underE strictE.
+rewrite -area3_cycle.
+rewrite -leNgt puefcpp'.
+have inle: (p_x hr - p_x hl) >0.
+  by rewrite subr_cp0.
+rewrite (pmulr_rle0 _ inle )  => inp'hr.
+have :=  (ax4_three_triangles hr  (left_pt low_e) (right_pt low_e) p') => /eqP <-.
+move : poep'.
+rewrite /point_on_edge=> /andP [] /eqP pue0 valp'.
+rewrite pue0.
+have := (area3_vert (right_pt low_e) eqxp'p  ).
+rewrite -area3_cycle eqxp'p => /eqP ->.
+move : valp'.
+rewrite /valid_edge => /andP [] xlhp' xrhp'.
+have xrhp'0: p_x p' - p_x (right_pt low_e) <=0.
+  by rewrite subr_cp0.
+rewrite add0r addr_ge0//.
+  by rewrite mulr_le0.
+have := (area3_vert (left_pt low_e) eqxp'p  ).
+rewrite area3_opposite -area3_cycle eqxp'p eqr_oppLR => /eqP ->.
+by rewrite -mulNr mulr_le0 // oppr_le0 subr_cp0.
+Qed.
+
+Lemma pue_right_edge e p :
+p_x (right_pt e) == p_x p ->
+(p <<= e) = ((p_y p - p_y (right_pt e)) <= 0).
+Proof.
+move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
+rewrite /point_under_edge/generic_trajectories.point_under_edge /=.
+move => /eqP <- /=.
+have := (pue_f_vert py ax ay bx b_y).
+rewrite pue_f_c /pue_f.
+move => /eqP ->.
+rewrite -subr_cp0 -opprB oppr_lt0 in inE.
+by rewrite subrr (pmulr_rle0 _  inE) .
+Qed.
+
+Lemma psue_right_edge e p :
+p_x (right_pt e) == p_x p ->
+(p <<< e) = ((p_y p - p_y (right_pt e)) < 0).
+Proof.
+move : e p  => [[ax ay][bx b_y] /= cnd] [px py]  /=.
+rewrite /point_strictly_under_edge/generic_trajectories.point_strictly_under_edge /=.
+rewrite R_ltb_lt.
+move => /eqP <- /=.
+have := (pue_f_vert py ax ay bx b_y).
+rewrite pue_f_c /pue_f.
+move => /eqP ->.
+rewrite -subr_gt0 in cnd.
+by rewrite subrr (pmulr_rlt0 _  cnd) .
+Qed.
+
+Lemma pue_left_edge e p :
+p_x (left_pt e) == p_x p ->
+(p <<= e) = (0 <= (p_y (left_pt e) - p_y p )).
+Proof.
+move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
+rewrite /point_under_edge.
+rewrite /generic_trajectories.point_under_edge /=.
+move => /eqP <- /=.
+have := (pue_f_vert ay bx b_y ax py).
+rewrite -pue_f_c /pue_f.
+move => /eqP ->.
+rewrite -subr_cp0 in inE.
+by rewrite subrr (nmulr_rle0 _  inE).
+Qed.
+
+Lemma psue_left_edge e p :
+p_x (left_pt e) == p_x p ->
+(p <<< e) = (0 < p_y (left_pt e) - p_y p).
+Proof.
+move: e p => [[ax ay][bx b_y] /= cnd] [px py] /=.
+move=> /eqP <- /=.
+rewrite /point_strictly_under_edge.
+rewrite /generic_trajectories.point_strictly_under_edge /=.
+rewrite R_ltb_lt.
+have := (pue_f_vert ay bx b_y ax py).
+rewrite -pue_f_c /pue_f => /eqP ->.
+rewrite -subr_cp0 in cnd.
+by rewrite subrr (nmulr_rlt0 _ cnd).
+Qed.
+
+Lemma not_strictly_under low_e high_e  :
+(left_pt low_e) <<= high_e ->
+(right_pt low_e) <<= high_e ->
+valid_edge low_e (right_pt high_e)  ->
+~~ (right_pt high_e <<< low_e).
+Proof.
+move => pableft pabright valright.
+have  := exists_point_valid valright.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx.
+apply :  not_strictly_under' pableft pabright poep' eqx.
+Qed.
+
+Lemma not_strictly_above low_e high_e :
+~~ (left_pt high_e <<< low_e) ->
+~~ (right_pt high_e <<< low_e) ->
+valid_edge (high_e) (right_pt (low_e)) ->
+right_pt (low_e) <<= high_e.
+Proof.
+move => pableft pabright valright.
+have  := exists_point_valid valright.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx.
+apply :  not_strictly_above' pableft pabright poep' eqx.
+Qed.
+
+Lemma on_edge_same_point e p p':
+p === e -> p' === e ->
+(p_x p == p_x p') -> (p_y p == p_y p').
+Proof.
+move : e => [l r ec].
+rewrite /point_on_edge /= => /andP [] p0 _ /andP[] p'0 _.
+have dif : p_x l != p_x r.
+  by apply/eqP=> abs; move: ec; rewrite abs ltxx.
+move: l r p0 p'0 dif {ec}=> [a_x a_y][b_x b_y] p0 p'0 dif.
+move: p p' p0 p'0 => [x y] [x' y'] puep0 puep'0.
+rewrite /=; apply: (pue_f_on_edge_same_point dif puep0 puep'0).
+Qed.
+
+Lemma strict_under_edge_lower_y r r' e :
+  p_x r = p_x r' -> r' === e -> (r <<< e) = (p_y r < p_y r').
+Proof.
+move=> rr' rone.
+have valre : valid_edge e r.
+  by case/andP: rone; rewrite /valid_edge/generic_trajectories.valid_edge rr'.
+move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
+  have req : r' = left_pt e.
+    have rltr : p_x r' < p_x (right_pt e) by rewrite -rr' -atl edge_cond.
+    have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
+    by move/andP: rone => [] -> _ /eqP.
+  by move/eqP/psue_left_edge: atl; rewrite subr_gt0 -req.
+have rue' : (r <<< e) = (area3 r (left_pt e) r' < 0).
+  move: rone=> /andP[] /[dup] tmp/area3_triangle_on_edge + _ => /(_ r).
+(* TODO : fix area3_triangle_on_edge for cycle *)
+  rewrite (area3_opposite (left_pt _)).
+  rewrite (area3_opposite (left_pt _) _ (right_pt _)) !mulrN.
+  rewrite inj_eq; last by apply: oppr_inj.
+  move/eqP => signcond.
+  move: (edge_cond e); rewrite -subr_gt0 => /pmulr_rlt0 <-.
+  rewrite signcond pmulr_rlt0; last by rewrite subr_gt0 -rr'.
+    rewrite /point_strictly_under_edge.
+    by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
+have inr' : p_x (left_pt e) < p_x r' by rewrite -rr'.
+have /psue_right_edge : p_x (right_pt (Bedge inr')) == p_x r.
+  by rewrite /= rr' eqxx.
+rewrite rue' subr_lt0.
+rewrite /point_strictly_under_edge.
+by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
+Qed.
+
+Lemma under_onVstrict e p :
+  valid_edge e p ->
+  (p <<= e) = (p === e) || (p <<< e).
+Proof.
+move=> valep.
+rewrite /point_under_edge /point_strictly_under_edge /point_on_edge.
+rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt.
+rewrite /generic_trajectories.point_under_edge subrr.
+by rewrite le_eqVlt valep andbT.
+Qed.
+
+Lemma onAbove e p : p === e -> ~~ (p <<< e).
+Proof.
+rewrite /point_on_edge /point_strictly_under_edge.
+rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt subrr.
+move=> /andP[cmp valep].
+by rewrite -leNgt le_eqVlt eq_sym cmp.
+Qed.
+
+Lemma strict_nonAunder e p :
+  valid_edge e p ->
+  (p <<< e) = (~~ (p === e)) && (p <<= e).
+Proof.
+move=> valep.
+rewrite /point_strictly_under_edge /point_on_edge /point_under_edge.
+rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt.
+rewrite /generic_trajectories.point_under_edge !subrr.
+by rewrite valep andbT lt_neqAle.
+Qed.
+
+Lemma under_edge_strict_lower_y (r r' : pt) e :
+  p_x r = p_x r' -> r != r' -> r <<= e -> r' === e -> p_y r < p_y r'.
+Proof.
+move=> xs nq under on'.
+have  vr : valid_edge e r.
+  by move: on'; rewrite /valid_edge/generic_trajectories.valid_edge xs=> /andP[].
+move: under; rewrite (under_onVstrict vr)=> /orP[on | ].
+  by case/negP: nq; rewrite pt_eqE (on_edge_same_point on on') xs eqxx.
+by rewrite (strict_under_edge_lower_y xs).
+Qed.
+
+Lemma above_edge_strict_higher_y (r r' : pt)  e :
+  p_x r = p_x r' -> r != r' -> r >>= e -> r' === e -> p_y r' < p_y r.
+Proof.
+move=> xs nq above on'.
+have  vr : valid_edge e r.
+  by move: on'; rewrite /valid_edge/generic_trajectories.valid_edge xs=> /andP[].
+move: above; rewrite (strict_under_edge_lower_y xs on') // -leNgt le_eqVlt.
+move/orP=> [/eqP ys | //].
+by case/negP: nq; rewrite pt_eqE xs ys !eqxx.
+Qed.
+
+Lemma under_edge_lower_y r r' e :
+  p_x r = p_x r' -> r' === e -> (r <<= e) = (p_y r <= p_y r').
+Proof.
+move=> rr' rone.
+have valre : valid_edge e r.
+  by case/andP: rone; rewrite /valid_edge/generic_trajectories.valid_edge rr'.
+move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
+  have req : r' = left_pt e.
+    have rltr : p_x r' < p_x (right_pt e) by rewrite -rr' -atl edge_cond.
+    have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
+    by move/andP: rone => [] -> _ /eqP.
+  by move/eqP/pue_left_edge: atl; rewrite subr_ge0 -req.
+have rue' : (r <<= e) = (area3 r (left_pt e) r' <= 0).
+  move: rone=> /andP[] /[dup] tmp/area3_triangle_on_edge + _ => /(_ r).
+(* TODO : fix area3_triangle_on_edge for cycle *)
+  rewrite (area3_opposite (left_pt _)).
+  rewrite (area3_opposite (left_pt _) _ (right_pt _)) !mulrN.
+  rewrite inj_eq; last by apply: oppr_inj.
+  move/eqP => signcond.
+  move: (edge_cond e); rewrite -subr_gt0 => /pmulr_rle0 <-.
+  rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
+  by rewrite signcond pmulr_rle0; last rewrite subr_gt0 -rr'.
+have inr' : p_x (left_pt e) < p_x r' by rewrite -rr'.
+rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
+have /pue_right_edge : p_x (right_pt (Bedge inr')) == p_x r.
+  by rewrite /= rr' eqxx.
+move: rue'.
+rewrite /point_under_edge/generic_trajectories.point_under_edge subrr=> rue'.
+by rewrite rue' subr_le0.
+Qed.
+
+Lemma aligned_trans a a' b p : p_x a != p_x b ->
+  area3 a' a b == 0 ->
+  area3 p a b == 0 -> area3 p a' b == 0.
+Proof.
+rewrite -area3_cycle.
+move=> bna /[dup]/area3_triangle_on_edge proc a'ab pab.
+have/mulfI/inj_eq <-  : p_x a - p_x b != 0 by rewrite subr_eq0.
+rewrite -area3_cycle -(eqP (proc _)).
+by rewrite area3_cycle (eqP pab) !mulr0.
+Qed.
+
+Lemma area3_change_ext a b a' b' p :
+  p_x a < p_x b -> p_x a' < p_x b' ->
+  area3 a' a b == 0 -> area3 b' a b == 0 ->
+  sg (area3 p a b) = sg (area3 p a' b').
+Proof.
+move=> altb altb' ona onb.
+have/area3_triangle_on_edge:= ona => /(_ p)/eqP ona'.
+have/area3_triangle_on_edge:= onb => /(_ p)/eqP onb0.
+have/area3_triangle_on_edge: area3 b' a' a == 0.
+  have bna : p_x b != p_x a by case: ltrgtP altb.
+  by rewrite (aligned_trans bna) //
+       area3_opposite oppr_eq0 area3_cycle.
+move=>/(_ p)/eqP onb'.
+have difab : 0 < p_x b - p_x a by rewrite subr_gt0.
+have difab' : 0 < p_x b' - p_x a' by rewrite subr_gt0.
+have [ | | aa' ] := ltrgtP (p_x a) (p_x a'); last first.
+- set w := Bedge altb.
+  have/on_edge_same_point tmp : a === Bedge altb by exact: left_on_edge.
+  have/(tmp _) : a' === Bedge altb.
+    rewrite /point_on_edge ona /valid_edge/generic_trajectories.valid_edge.
+    by rewrite /= -aa' lexx ltW.
+  rewrite aa'=> /(_ (eqxx _))/eqP ays.
+  have aa : a = a' by move: (a) (a') aa' ays=> [? ?][? ?] /= -> ->.
+  rewrite -aa area3_opposite [in RHS]area3_opposite.
+  rewrite -[RHS]mul1r -(gtr0_sg difab) -sgrM mulrN onb0 [X in _ - X]aa' -mulrN.
+  by rewrite sgrM (gtr0_sg difab') mul1r.
+- rewrite -subr_gt0=> xalta'; rewrite -[RHS]mul1r -(gtr0_sg xalta') -sgrM.
+  rewrite [in RHS]area3_opposite mulrN onb' -mulrN sgrM (gtr0_sg difab').
+  rewrite -area3_opposite -[in RHS]area3_cycle.
+  rewrite -(gtr0_sg difab) -sgrM ona' [in RHS]area3_opposite.
+  by rewrite mulrN -mulNr opprB sgrM (gtr0_sg xalta') mul1r.
+rewrite -subr_lt0=> xa'lta; apply/esym. 
+rewrite area3_opposite -[X in -X]mul1r -mulNr sgrM sgrN1.
+rewrite -(ltr0_sg xa'lta) -sgrM onb' sgrM (gtr0_sg difab').
+rewrite area3_opposite -area3_cycle sgrN mulrN -(gtr0_sg difab).
+rewrite -sgrM ona' -sgrN -mulNr opprB sgrM (ltr0_sg xa'lta).
+by rewrite area3_opposite sgrN mulrN mulNr opprK mul1r.
+Qed.
+
+Lemma under_low_imp_under_high low_e high_e p  :
+(left_pt low_e) <<= high_e ->
+(right_pt low_e) <<= high_e ->
+valid_edge low_e p ->
+valid_edge high_e p ->
+p <<= low_e -> p <<= high_e.
+Proof.
+move : low_e high_e => [ll lr inL] [hl hr inH]  /=.
+move => pulh purh vallow valhigh.
+have  := exists_point_valid vallow.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx'.
+have  := exists_point_valid valhigh.
+move => [] p'' vip' .
+have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+have := poep''.
+have := poep'.
+
+rewrite /point_on_edge /valid_edge
+  /generic_trajectories.valid_edge =>  /andP [] /= poepf' /andP []
+ linfp' p'infr   /andP [] /= poepf'' /andP [] linfp'' p''infr.
+
+rewrite -area3_cycle in poepf'.
+rewrite -eqx' in linfp' p'infr.
+rewrite -eqx'' in linfp'' p''infr.
+move => puep.
+
+have ydiff : p_y p <= p_y p'.
+  by rewrite -(under_edge_lower_y eqx' poep').
+
+rewrite eqx' in eqx''.
+have puep' := (point_on_edge_under  poep' pulh purh).
+have y'diff : p_y p' <= p_y p''.
+  by rewrite -(under_edge_lower_y eqx'' poep'').
+have y''diff: (p_y p  <= p_y p'').
+  by rewrite (le_trans  ydiff y'diff).
+rewrite -eqx' in eqx''.
+have := ax4_three_triangles p hl hr p''.
+have /eqP pHleq :=  (area3_vert hl eqx'').
+have /eqP pHreq :=  (area3_vert hr eqx'').
+rewrite -area3_cycle in pHreq.
+rewrite area3_opposite -area3_cycle in pHleq.
+
+move : poepf'' pHreq => /eqP ->  -> .
+have :  area3 p hl p'' = - ((p_x p - p_x hl) * (p_y p'' - p_y p)).
+  by rewrite -pHleq opprK.
+move => ->.
+rewrite add0r -mulrBl.
+rewrite  [x in (x - _) * _ == _] addrC.
+rewrite addrKA opprK.
+
+rewrite /point_under_edge /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
+rewrite underE.
+rewrite addrC.
+have inH' := inH.
+rewrite -subr_cp0 in inH'.
+rewrite -subr_ge0 in y''diff.
+move => /eqP <-.
+by rewrite nmulr_rle0.
+Qed.
+
+Lemma under_low_imp_strict_under_high low_e high_e p  :
+(left_pt low_e) <<= high_e ->
+(right_pt low_e) <<= high_e ->
+valid_edge low_e p ->
+valid_edge high_e p ->
+p <<< low_e -> p <<< high_e.
+Proof.
+move : low_e high_e => [ll lr inL] [hl hr inH]  /=.
+move => pulh purh vallow valhigh.
+have  := exists_point_valid vallow.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx'.
+have  := exists_point_valid valhigh.
+move => [] p'' vip' .
+have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+have := poep''.
+have := poep'.
+
+rewrite /point_on_edge /valid_edge =>  /andP [] /= poepf' /andP []
+ linfp' p'infr   /andP [] /= poepf'' /andP [] linfp'' p''infr.
+
+rewrite -area3_cycle in poepf'.
+rewrite -eqx' in linfp' p'infr.
+rewrite -eqx'' in linfp'' p''infr.
+move => puep.
+
+have ydiff : p_y p < p_y p'.
+  by rewrite -(strict_under_edge_lower_y eqx' poep').
+
+rewrite eqx' in eqx''.
+have puep' := (point_on_edge_under  poep' pulh purh).
+have y'diff : p_y p' <= p_y p''.
+  by rewrite -(under_edge_lower_y eqx'' poep'').
+have y''diff: (p_y p  < p_y p'').
+  by rewrite (lt_le_trans  ydiff y'diff).
+rewrite -eqx' in eqx''.
+have := ax4_three_triangles p hl hr p''.
+have /eqP pHleq :=  (area3_vert hl eqx'').
+have /eqP pHreq :=  (area3_vert hr eqx'').
+rewrite -area3_cycle in pHreq.
+rewrite area3_opposite -area3_cycle in pHleq.
+
+move : poepf'' pHreq => /eqP ->  -> .
+have :  area3 p hl p'' = - ((p_x p - p_x hl) * (p_y p'' - p_y p)).
+  by rewrite -pHleq opprK.
+move => ->.
+rewrite add0r -mulrBl.
+rewrite  [x in (x - _) * _ == _] addrC.
+rewrite addrKA opprK.
+
+rewrite /point_strictly_under_edge /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
+rewrite addrC.
+have inH' := inH.
+rewrite -subr_cp0 in inH'.
+rewrite -subr_gt0 in y''diff.
+rewrite strictE.
+move => /eqP <-.
+by rewrite nmulr_rlt0.
+Qed.
+
+Lemma under_low_imp_under_high_bis low_e high_e p  :
+~~ (left_pt high_e <<< low_e) ->
+~~ (right_pt high_e <<< low_e) ->
+valid_edge low_e p ->
+valid_edge high_e p ->
+p <<= low_e -> p <<= high_e.
+Proof.
+move : low_e high_e => [ll lr inL] [hl hr inH]  .
+move => pabhl pabhr vallow valhigh.
+have  := exists_point_valid vallow.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx'.
+have  := exists_point_valid valhigh.
+move => [] p'' vip' .
+have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+have := poep''.
+have := poep'.
+
+rewrite /point_on_edge /valid_edge =>  /andP [] /= poepf' /andP []
+ linfp' p'infr   /andP [] /= poepf'' /andP [] linfp'' p''infr.
+
+rewrite -area3_cycle in poepf'.
+rewrite -eqx' in linfp' p'infr.
+rewrite -eqx'' in linfp'' p''infr.
+move => /= puep.
+
+have ydiff : p_y p <= p_y p'.
+  by rewrite -(under_edge_lower_y eqx' poep').
+rewrite eqx' in eqx''.
+symmetry in eqx''.
+have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
+have y'diff : p_y p' <= p_y p''.
+  by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
+have y''diff: (p_y p  <= p_y p'').
+  by rewrite (le_trans  ydiff y'diff).
+rewrite -eqx' in eqx''.
+have := ax4_three_triangles p hl hr p''.
+have /eqP pHleq :=  (area3_vert hl eqx'').
+have /eqP pHreq :=  (area3_vert hr eqx'').
+
+rewrite area3_opposite in pHreq.
+rewrite area3_cycle in pHleq.
+
+move : poepf'' pHleq => /eqP  ->  -> .
+have :  area3 p p'' hr = - ((p_x p'' - p_x hr) * (p_y p - p_y p'')).
+  by rewrite -pHreq opprK.
+move => ->.
+rewrite add0r addrC -mulrBl.
+rewrite  [x in (x - _) * _ == _] addrC.
+rewrite addrKA opprK.
+
+rewrite /point_under_edge /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
+rewrite addrC.
+have inH' := inH.
+rewrite -subr_gte0 in inH'.
+rewrite -subr_le0 in y''diff.
+rewrite underE.
+move => /eqP <-.
+by rewrite pmulr_rle0.
+Qed.
+
+Lemma under_low_imp_strict_under_high_bis low_e high_e p  :
+~~ (left_pt high_e <<< low_e) ->
+~~ (right_pt high_e <<< low_e) ->
+valid_edge low_e p ->
+valid_edge high_e p ->
+p <<< low_e -> p <<< high_e.
+Proof.
+move : low_e high_e => [ll lr inL] [hl hr inH]  .
+move => pabhl pabhr vallow valhigh.
+have  := exists_point_valid vallow.
+move => [] p' vip .
+have  := intersection_on_edge vip => [][] poep' eqx'.
+have  := exists_point_valid valhigh.
+move => [] p'' vip' .
+have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+have := poep''.
+have := poep'.
+
+rewrite /point_on_edge /valid_edge =>  /andP [] /= poepf' /andP []
+ linfp' p'infr   /andP [] /= poepf'' /andP [] linfp'' p''infr.
+
+rewrite -area3_cycle in poepf'.
+rewrite -eqx' in linfp' p'infr.
+rewrite -eqx'' in linfp'' p''infr.
+move => /= puep.
+
+have ydiff : p_y p < p_y p'.
+  by rewrite -(strict_under_edge_lower_y eqx' poep').
+
+rewrite eqx' in eqx''.
+symmetry in eqx''.
+have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
+have y'diff : p_y p' <= p_y p''
+   by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
+have y''diff: (p_y p  < p_y p'').
+  by rewrite (lt_le_trans  ydiff y'diff).
+rewrite -eqx' in eqx''.
+have := ax4_three_triangles p hl hr p''.
+have /eqP pHleq :=  (area3_vert hl eqx'').
+have /eqP pHreq :=  (area3_vert hr eqx'').
+
+rewrite area3_opposite in pHreq.
+rewrite area3_cycle in pHleq.
+
+move : poepf'' pHleq => /eqP  ->  -> .
+have :  area3 p p'' hr = - ((p_x p'' - p_x hr) * (p_y p - p_y p'')).
+  by rewrite -pHreq opprK.
+move => ->.
+rewrite add0r addrC -mulrBl.
+rewrite  [x in (x - _) * _ == _] addrC.
+rewrite addrKA opprK.
+
+rewrite /point_strictly_under_edge /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
+rewrite addrC.
+have inH' := inH.
+rewrite -subr_gte0 in inH'.
+rewrite -subr_lt0 in y''diff.
+rewrite strictE.
+move => /eqP <-.
+by rewrite pmulr_rlt0.
+Qed.
+
+Lemma order_edges_viz_point' low_e high_e p :
+valid_edge low_e p -> valid_edge high_e p ->
+low_e <| high_e ->
+p <<= low_e -> p <<= high_e.
+Proof.
+move => vallow valhigh.
+have  := (exists_point_valid  vallow  ) .
+have := (exists_point_valid  valhigh  ) => [][] ph verhigh [] pl verlow.
+have  := intersection_on_edge verlow => [][] poepl eqxl.
+have  := intersection_on_edge verhigh => [][] poeph eqxh.
+rewrite /edge_below => /orP [] /andP [].
+  move => pueplow puephigh.
+  apply (under_low_imp_under_high pueplow puephigh vallow valhigh).
+move => pabpleft pabpright.
+  apply (under_low_imp_under_high_bis pabpleft pabpright vallow valhigh).
+Qed.
+
+Lemma order_edges_strict_viz_point' low_e high_e p :
+valid_edge low_e p -> valid_edge high_e p ->
+low_e <| high_e ->
+p <<< low_e ->  p <<< high_e.
+Proof.
+move => vallow valhigh.
+have  := (exists_point_valid  vallow  ) .
+have := (exists_point_valid  valhigh  ) => [][] ph verhigh [] pl verlow.
+have  := intersection_on_edge verlow => [][] poepl eqxl.
+have  := intersection_on_edge verhigh => [][] poeph eqxh.
+rewrite /edge_below => /orP [] /andP [].
+  set A := left_pt low_e.
+  set B := right_pt low_e.
+  move => pueplow puephigh.
+  move =>  inf0.
+  have:= inf0; rewrite /point_strictly_under_edge.
+  rewrite strictE.
+  move=> /ltW; rewrite -/A -/B => infeq0.
+  have := (under_low_imp_strict_under_high pueplow puephigh vallow valhigh inf0).
+  by rewrite /point_strictly_under_edge strictE.
+move=> pueplow puephigh.
+move=> inf0.
+by have := (under_low_imp_strict_under_high_bis pueplow puephigh vallow valhigh inf0).
+Qed.
+
+Lemma edge_dir_intersect p1 p2 e1 :
+  p_x p1 != p_x p2 ->
+  ~~(p1 <<= e1) -> p2 <<< e1 ->
+ exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\
+      area3 p p1 p2 = 0 /\
+   (forall q, area3 q (left_pt e1) (right_pt e1) = 0 ->
+       area3 q p1 p2 = 0 -> p = q).
+Proof.
+move=> dif12.
+rewrite /point_under_edge underE.
+rewrite area3E -ltNge => ca.
+rewrite /point_strictly_under_edge strictE.
+rewrite area3E => cu.
+have [px [py []]] := line_intersection dif12 ca cu.
+rewrite -/(p_y (Bpt px py)); set py' := (p_y (Bpt px py)).
+rewrite -/(p_x (Bpt px py)) /py' {py'}.
+move: ca cu; rewrite -4!area3E=> ca cu on_line1 [] on_line2 uniq.
+exists (Bpt px py); rewrite on_line1 on_line2;split;[ | split]=> //.
+by move=> [qx qy]; rewrite !area3E=> /uniq => U; move=> {}/U[] /= -> ->.
+Qed.
+
+Lemma intersection_middle_au e1 e2 :
+  ~~ (left_pt e2 <<= e1) -> right_pt e2 <<< e1 ->
+  exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\ p === e2.
+Proof.
+move=> /[dup] ca; rewrite -ltNge subrr=> ca' /[dup] cu cu'.
+rewrite /point_strictly_under_edge strictE in cu'.
+have le2xnre2x : p_x (left_pt e2) != p_x (right_pt e2).
+  by have := edge_cond e2; rewrite lt_neqAle=> /andP[].
+have [p [p1 [p2 pu]]] := edge_dir_intersect le2xnre2x ca cu.
+exists p; rewrite p1; split=> //.
+rewrite /point_on_edge p2 eqxx /= /valid_edge.
+rewrite /generic_trajectories.valid_edge.
+have/eqP ol2 := p2.
+have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
+rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
+case : (ltP (p_x p) (p_x (right_pt e2))).
+  move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
+  rewrite -(pmulr_lgt0 _ ca') signcond.
+  by rewrite nmulr_lgt0 // => /ltW.
+move=>/[dup] re2lp.
+rewrite -subr_le0 -(pmulr_lle0 _ ca') signcond.
+by rewrite nmulr_lle0 // subr_ge0=> /(le_trans re2lp); rewrite leNgt edge_cond.
+Qed.
+
+Lemma intersection_middle_ua e1 e2 :
+  left_pt e2 <<< e1 -> ~~(right_pt e2 <<= e1) ->
+  exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\ p === e2.
+Proof.
+move=> /[dup] cu cu' /[dup] ca; rewrite -ltNge subrr=> ca'.
+rewrite /point_strictly_under_edge strictE in cu'.
+have re2xnle2x : p_x (right_pt e2) != p_x (left_pt e2).
+  by have := edge_cond e2; rewrite lt_neqAle eq_sym=> /andP[].
+have [p [p1 [p2 pu]]] := edge_dir_intersect re2xnle2x ca cu.
+move: p2; rewrite area3_opposite area3_cycle => /eqP.
+rewrite oppr_eq0=> /[dup] ol2 /eqP p2.
+exists p; rewrite p1; split=> //.
+rewrite /point_on_edge p2 eqxx /= /valid_edge.
+rewrite /generic_trajectories.valid_edge.
+have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
+rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
+case : (ltP (p_x p) (p_x (right_pt e2))).
+  move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
+  rewrite -(nmulr_llt0 _ cu') signcond.
+  by rewrite pmulr_llt0 // => /ltW.
+move=>/[dup] re2lp.
+rewrite -subr_le0 -(nmulr_lge0 _ cu') signcond.
+by rewrite pmulr_lge0 // subr_ge0=> /(le_trans re2lp); rewrite leNgt edge_cond.
+Qed.
+
+Definition lexPt (p1 p2 : pt) : bool :=
+  (p_x p1 < p_x p2) || ((p_x p1 == p_x p2) && (p_y p1 < p_y p2)).
+
+Definition lexePt (p1 p2 : pt) : bool :=
+    (p_x p1 < p_x p2) || ((p_x p1 == p_x p2) && (p_y p1 <= p_y p2)).
+
+Lemma lexPtW p1 p2 :
+  lexPt p1 p2 -> lexePt p1 p2.
+Proof.
+rewrite /lexPt /lexePt =>/orP [-> //=| /andP [] -> y_ineq].
+rewrite ltW //. 
+by rewrite orbT.
+Qed.
+
+Lemma lexePtNgt (p1 p2 : pt) : lexePt p1 p2 = ~~lexPt p2 p1.
+Proof.
+rewrite /lexePt /lexPt negb_or negb_and.
+rewrite andb_orr -leNgt (andbC (_ <= _)) (eq_sym (p_x p2)) -lt_neqAle.
+rewrite -leNgt (le_eqVlt (p_x p1)).
+by case: (p_x p1 < p_x p2) => //; rewrite ?orbF //=.
+Qed.
+
+Lemma lexPtNge (p1 p2 : pt) : lexPt p1 p2 = ~~lexePt p2 p1.
+Proof.
+rewrite /lexePt /lexPt.
+rewrite negb_or -leNgt negb_and (eq_sym (p_x p2)) andb_orr (andbC (_ <= _)).
+rewrite -lt_neqAle le_eqVlt -ltNge.
+by case: (p_x p1 < p_x p2); rewrite // ?orbF.
+Qed.
+
+Lemma lexePt_eqVlt (p1 p2 :pt) : lexePt p1 p2 = (p1 == p2) || lexPt p1 p2.
+Proof.
+rewrite /lexePt /lexPt.
+case: (ltrgtP (p_x p1) (p_x p2))=> cnd; rewrite ?orbT //= ?orbF.
+  by apply/esym/negP=> /eqP p1p2; move: cnd; rewrite p1p2 ltxx.
+apply/idP/idP.
+  rewrite orbC le_eqVlt=> /orP[/eqP | ->// ].
+  move: cnd; case: p1 => [a b]; case: p2 => [c d]/= -> ->.
+  by rewrite eqxx orbT.
+by move/orP=> [/eqP -> // | /ltW].
+Qed.
+
+Lemma lexPt_irrefl : irreflexive lexPt.
+Proof.
+move=> x; apply/negP=> /[dup] abs.
+by rewrite lexPtNge lexePt_eqVlt abs orbT.
+Qed.
+
+Lemma lexePt_refl : reflexive lexePt.
+Proof.
+rewrite /reflexive /lexePt=> p.
+by rewrite eqxx le_refl /= orbT.
+Qed.
+
+Lemma lexPt_trans  : transitive lexPt.
+Proof.
+  rewrite /transitive /lexPt => p2 p1 p3 => /orP [xineq /orP [xineq2| /andP []/eqP <- yineq]|/andP []/eqP -> yineq /orP [-> //|/andP [] /eqP -> yineq2]] .
+      by rewrite (lt_trans xineq xineq2).
+    by rewrite xineq.
+  by rewrite (lt_trans yineq yineq2) eqxx orbT.
+Qed.
+
+Lemma lexePt_lexPt_trans p1 p2 p3 : 
+lexePt p1 p2 -> lexPt p2 p3 -> lexPt p1 p3.
+Proof.
+rewrite /lexePt /lexPt => /orP  [x_ineq|/andP  [] /eqP -> y_ineq /orP [-> // |/andP []/eqP -> y_s]].
+  have : lexPt p1 p2.
+    by rewrite /lexPt x_ineq.
+  by apply lexPt_trans.
+by rewrite( le_lt_trans y_ineq y_s) eqxx /= orbT.
+Qed.
+
+Lemma lexPt_lexePt_trans p1 p2 p3 :
+lexPt p1 p2 -> lexePt p2 p3 -> lexPt p1 p3.
+Proof.
+move/[swap].
+rewrite /lexePt /lexPt => /orP  [x_ineq|/andP  [] /eqP -> y_ineq /orP [-> // |/andP []/eqP -> y_s]].
+  have : lexPt p2 p3.
+    by rewrite /lexPt x_ineq.
+  move/[swap]; apply lexPt_trans.
+by rewrite( lt_le_trans y_s y_ineq) eqxx /= orbT.
+Qed.
+
+Lemma lexePt_trans : transitive lexePt.
+move => p2 p1 p3; rewrite lexePt_eqVlt => /orP[/eqP-> // | p1p2] p2p3.
+by apply/lexPtW/(lexPt_lexePt_trans p1p2).
+Qed.
+
+Lemma lexePt_xW p1 p2 : lexePt p1 p2 -> p_x p1 <= p_x p2.
+Proof.
+by rewrite /lexePt=> /orP[/ltW | /andP [/eqP -> _]].
+Qed.
+
+Lemma on_edge_lexePt_left_pt (p : pt) g :
+  p === g -> lexePt (left_pt g) p.
+Proof.
+move=> on.
+have : p_x (left_pt g) <= p_x p by move: on=> /andP[] _ /andP[].
+rewrite le_eqVlt=> /orP[/eqP/esym /[dup] samex' /eqP samex | xlt ].
+ have/eqP samey := on_edge_same_point on (left_on_edge _) samex.
+  have -> : p = left_pt g.
+    by apply/eqP; rewrite pt_eqE samex' samey !eqxx.
+  by apply: lexePt_refl.
+by rewrite /lexePt xlt.
+Qed.
+
+Lemma trans_edge_below_out p e1 e2 e3 :
+  left_pt e1 = p -> left_pt e2 = p -> left_pt e3 = p ->
+  e1 <| e2 -> e2 <| e3 -> e1 <| e3.
+Proof.
+case: e1 => [d [a_x a_y] /= cpa].
+case: e2 => [d' [b_x b_y] /= cpb].
+case: e3 => [d'' [c_x c_y] /= cpc] dp d'p d''p.
+rewrite /edge_below /point_under_edge /point_strictly_under_edge.
+rewrite !underE !strictE.
+rewrite !area3E; simpl left_pt; simpl right_pt.
+move: cpa cpb cpc; rewrite dp d'p d''p {dp d'p d''p}.
+case: p=> [px py]; simpl p_x; simpl p_y=> cpa cpb cpc.
+move=> c1' c2'.
+have c1 : 0 <= pue_f px py a_x a_y b_x b_y.
+  move: c1'; rewrite !(eqP (pue_f_eq _ _ _ _)) lexx ltxx !andTb -leNgt.
+  by rewrite pue_f_o oppr_lte0 (pue_f_c px)=> /orP[].
+have c2 : 0 <= pue_f px py b_x b_y c_x c_y.
+  move: c2'; rewrite !(eqP (pue_f_eq _ _ _ _)) lexx ltxx !andTb -leNgt.
+  by rewrite pue_f_o oppr_lte0 (pue_f_c px)=> /orP[].
+move=> {c1' c2'}.
+apply/orP; left.
+rewrite (eqP (pue_f_eq _ _ _ _)) lexx andTb pue_f_o -pue_f_c oppr_lte0.
+set p := Bpt px py.
+have aright : 0 < area3 p (subpoint p) (Bpt a_x a_y).
+  by apply: point_sub_right.
+have bright : 0 < area3 p (subpoint p) (Bpt b_x b_y).
+  by apply: point_sub_right.
+have cright : 0 < area3 p (subpoint p) (Bpt c_x c_y).
+  by apply: point_sub_right.
+rewrite area3E in aright; simpl p_x in aright; simpl p_y in aright.
+rewrite area3E in bright; simpl p_x in bright; simpl p_y in bright.
+rewrite area3E in cright; simpl p_x in cright; simpl p_y in cright.
+rewrite -(pmulr_lge0 _ bright) -pue_f_ax5.
+by apply: addr_ge0; rewrite pmulr_lge0.
+Qed.
+
+Lemma no_crossingE e1 e2 :
+  below_alt e1 e2 -> valid_edge e2 (left_pt e1) ->
+  (left_pt e1 <<< e2 -> e1 <| e2) /\ (~~(left_pt e1 <<= e2) -> e2 <| e1).
+Proof.
+move=> nc ve.
+case: (exists_point_valid ve) => [p pP].
+move: (intersection_on_edge pP)=> [pone2 px].
+move: (pone2); rewrite /point_on_edge=> /andP[] pone2' vp.
+have xbnd1 : p_x (left_pt e2) <= p_x (left_pt e1) by case/andP: ve.
+have xbnd2 : p_x (left_pt e1) <= p_x (right_pt e2) by case/andP: ve.
+have dify : ((left_pt e1 <<< e2) \/ (~~(left_pt e1 <<= e2))) -> p_y (left_pt e1) != p_y p.
+  move=> disj; apply/negP=> /eqP A.
+  have {A}-A : p = left_pt e1 by case: (p) (left_pt e1) px A=> [? ?][? ?]/= -> ->.
+  by move: disj; rewrite under_onVstrict // strict_nonAunder // -A pone2; case.
+have pone2'': pue_f (p_x (left_pt e2)) (p_y (left_pt e2))
+             (p_x (right_pt e2)) (p_y (right_pt e2))
+             (p_x p) (p_y p) == 0.
+  by rewrite -pue_f_c; move: pone2'; rewrite area3E pue_f_c.
+move: (edge_cond e2); rewrite -(subr_gt0 (p_x _))=> ce2.
+have dife2 : 0 < p_x (right_pt e2) - p_x (left_pt e2).
+  by move: (edge_cond e2); rewrite -(subr_gt0 (p_x _)).
+have dife2' : p_x (right_pt e2) - p_x (left_pt e2) != 0.
+  by move: dife2; rewrite  lt_neqAle eq_sym=> /andP[].
+have plp2 : p_x (left_pt e2) = p_x (left_pt e1) -> p = left_pt e2.
+  move=> c; have:= on_edge_same_point pone2 (left_on_edge _).
+  rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
+  by case: (p) (left_pt e2)=> [? ?][? ?]/= <- <- ->.
+have prp2 : p_x (right_pt e2) = p_x (left_pt e1) -> p = right_pt e2.
+  move=> c; have:= on_edge_same_point pone2 (right_on_edge _).
+  rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
+  by case: (p) (right_pt e2)=> [? ?][? ?]/= <- <- ->.
+have main : (0 < area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
+       (p_y p < p_y (left_pt e1)).
+  move: xbnd1; rewrite le_eqVlt=> /orP[/eqP atleft | notleft ].
+    have pisl : p = left_pt e2 by apply: plp2.
+    move: atleft; rewrite -pisl=> atleft; rewrite edge_and_left_vertical //.
+    by rewrite -atleft pisl (edge_cond e2).
+  have fact1 : (0 < p_x p - p_x (left_pt e2)) by rewrite subr_gt0 -px.
+  rewrite -(pmulr_rgt0 _ fact1) area3_opposite mulrN.
+  rewrite -(eqP (area3_triangle_on_edge (left_pt e1) pone2')) -mulrN.
+  rewrite -area3_opposite area3_cycle pmulr_rgt0 //.
+  by apply: edge_and_right_vertical; rewrite -px.
+have arith : forall (a b : R), a <= 0 -> b <= 0 -> a + b <= 0.
+  clear=> a b al0 bl0.
+  by rewrite -lerBrDr (le_trans al0) // lerBrDr add0r.
+have case1 : left_pt e1 <<< e2 -> e1 <| e2.
+  move=> below; case:(nc) => // /orP[]; last by rewrite below.
+  move/andP=> []le2b re2b.
+  have pyne1 : p_y (left_pt e1) != p_y p by apply: dify; left.
+  have ys : p_y (left_pt e1) < p_y p.
+    rewrite ltNge le_eqVlt -main negb_or eq_sym pyne1 /= -leNgt le_eqVlt.
+    by move: (below); rewrite /point_strictly_under_edge strictE orbC => ->.
+  have : 0 < area3 p (left_pt e1) (right_pt e1).
+    by rewrite edge_and_left_vertical // -px (edge_cond e1).
+  rewrite -(pmulr_rgt0 _ ce2).
+  rewrite (eqP (area3_on_edge (left_pt e1) (right_pt e1) pone2')).
+  rewrite ltNge arith //.
+    apply: mulr_ge0_le0; first by rewrite -px subr_ge0.
+    by move: re2b; rewrite /point_under_edge underE -area3_cycle.
+  apply: mulr_ge0_le0; first by rewrite -px subr_ge0.
+  by move: le2b; rewrite /point_under_edge underE -area3_cycle.
+suff case2 : ~~(left_pt e1 <<= e2) -> e2 <| e1 by [].
+move=> above; case: (nc) => // /orP[]; first by rewrite (negbTE above).
+rewrite /point_strictly_under_edge !strictE -!leNgt => /andP[] le2a re2a.
+have pyne1 : p_y (left_pt e1) != p_y p by apply: dify; right.
+have ys : p_y p < p_y (left_pt e1).
+  by rewrite -main;move: (above); rewrite /point_under_edge -ltNge subrr.
+have : 0 < area3 (left_pt e1) p (right_pt e1).
+  by rewrite edge_and_left_vertical // (edge_cond e1).
+rewrite area3_opposite -area3_cycle.
+rewrite -(pmulr_rgt0 _ dife2) mulrN.
+move: (eqP (area3_on_edge (left_pt e1) (right_pt e1) pone2')) => ->.
+by rewrite oppr_gt0 ltNge addr_ge0 // mulr_ge0 // -px subr_ge0.
+Qed.
+
+
+Lemma inter_at_ext_no_crossing (s : seq edge) :
+  {in s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s &, no_crossing}.
+Proof.
+move=> nc e1 e2 e1in e2in.
+have nc' := inter_at_ext_sym nc.
+have ceq : e1 = e2 -> below_alt e1 e2.
+  move=> <-; left; apply/orP; left; rewrite /point_under_edge !underE.
+  rewrite (fun a b => eqP (proj1 (area3_two_points a b))).
+  rewrite (fun a b => eqP (proj1 (proj2 (area3_two_points a b)))).
+  by rewrite lexx.
+have [/eqP/ceq // | e1ne2] := boolP(e1 == e2).
+have [/eqP | {}nc ] := nc _ _ e1in e2in; first by rewrite (negbTE e1ne2).
+have [/eqP | {}nc' ] := nc' _ _ e1in e2in; first by rewrite (negbTE e1ne2).
+have [ | ] := boolP(e1 <| e2); first by left.
+have [ | ] := boolP(e2 <| e1); first by right.
+rewrite /edge_below.
+rewrite !negb_or. rewrite 4!negb_and !negbK.
+rewrite /edge_below/point_under_edge !underE.
+rewrite /point_strictly_under_edge !strictE => noc.
+suff [it | [p [pone1 pone2]]] :
+  below_alt e1 e2 \/ exists p, p === e1 /\ p === e2; first by [].
+  have : p \in [:: left_pt e1; right_pt e1] by apply: nc.
+  rewrite !inE=> pext.
+  set other := if p == left_pt e1 then right_pt e1 else left_pt e1.
+  have dif : right_pt e1 != left_pt e1.
+    apply/eqP=> abs.
+    move: (edge_cond e1); rewrite lt_neqAle eq_sym => /andP[].
+    by rewrite abs eqxx.
+  have [ u' | /underWC a'] := boolP (other <<= e2).
+    left; apply/orP; left.
+    move: (pone2) u'=> /andP[] _ /under_onVstrict.
+    rewrite pone2 /= /other.
+    by  move: pext=> /orP[] /eqP -> ->; rewrite ?eqxx ?(negbTE dif) ?andbT.
+  right; apply/orP; right.
+    move: (pone2) a'=> /andP[] _/strict_nonAunder; rewrite pone2 /= /other.
+    by move: pext=>/orP[]/eqP -> ->; rewrite ?eqxx ?(negbTE dif)=> ->.
+move: noc {nc nc'} => /andP[] /orP[le2a | re2a].
+  have le2a' : left_pt e2 >>> e1.
+    by rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
+  have [ re2u | re2a _] := boolP(right_pt e2 <<< e1); last first.
+    by left; left; apply/orP; right; rewrite re2a underWC.
+  have dif2 : p_x (left_pt e2) != p_x (right_pt e2).
+    by have := edge_cond e2; rewrite lt_neqAle => /andP[].
+  have [r [_ [ _ uniq]]] := edge_dir_intersect dif2 le2a' re2u.
+  move=> /orP[le1u | re1u].
+    have [re1u | re1a] := boolP(right_pt e1 <<= e2).
+      left; left; apply/orP; left; rewrite re1u underW //.
+      by rewrite /point_strictly_under_edge strictE.
+    have le1u' : left_pt e1 <<< e2.
+      by rewrite /point_strictly_under_edge strictE.
+    have [p [pe2 pe1]] := intersection_middle_ua le1u' re1a.
+    have [q [qe1 qe2]] := intersection_middle_au le2a' re2u.
+    move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP qe2' _.
+    have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
+    by right; exists r; rewrite [X in X === e2]rq rp.
+  have [le1u | le1a] := boolP(left_pt e1 <<= e2).
+      left; left; apply/orP; left; rewrite le1u underW //.
+      by rewrite /point_strictly_under_edge strictE.
+  have [q [qe1 qe2]] := intersection_middle_au le2a' re2u.
+  have re1u' : right_pt e1 <<< e2.
+    by rewrite /point_strictly_under_edge strictE.
+  have [p [pe2 pe1]] := intersection_middle_au le1a re1u'.
+  move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP qe2' _.
+  have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
+  by right; exists r; rewrite [X in X === e2]rq rp.
+have re2a' : right_pt e2 >>> e1.
+  by rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
+have [ le2u | le2a _] := boolP(left_pt e2 <<< e1); last first.
+  by left; left; apply/orP; right; rewrite le2a underWC.
+have dif2 : p_x (right_pt e2) != p_x (left_pt e2).
+  by have := edge_cond e2; rewrite lt_neqAle eq_sym => /andP[].
+have [r [_ [ _ uniq]]] := edge_dir_intersect dif2 re2a' le2u.
+have transfer a b c : area3 a b c = 0 -> area3 a c b = 0.
+  by move=> abc; rewrite area3_opposite area3_cycle abc oppr0.
+move=> /orP[le1u | re1u].
+  have [re1u | re1a] := boolP(right_pt e1 <<= e2).
+    left; left; apply/orP; left; rewrite re1u underW //.
+    by rewrite /point_strictly_under_edge strictE.
+  have le1u' : left_pt e1 <<< e2.
+    by rewrite /point_strictly_under_edge strictE.
+  have [p [/transfer pe2 pe1]] := intersection_middle_ua le1u' re1a.
+  have [q [qe1 qe2]] := intersection_middle_ua le2u re2a'.
+  move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP /transfer qe2' _.
+  have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
+  by right; exists r; rewrite [X in X === e2]rq rp.
+have [le1u | le1a] := boolP(left_pt e1 <<= e2).
+  left; left; apply/orP; left; rewrite le1u underW //.
+  by rewrite /point_strictly_under_edge strictE.
+have [q [qe1 qe2]] := intersection_middle_ua le2u re2a'.
+have re1u' : right_pt e1 <<< e2.
+  by rewrite /point_strictly_under_edge strictE.
+have [p [/transfer pe2 pe1]] := intersection_middle_au le1a re1u'.
+move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP /transfer qe2' _.
+have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
+by right; exists r; rewrite [X in X === e2]rq rp.
+Qed.
+
+Lemma outgoing_conditions (s oe : seq edge) p he le :
+  p >>> le -> p <<< he -> le \in s -> he \in s ->
+  valid_edge le p -> valid_edge he p ->
+  {subset oe <= s} ->
+  {in s &, no_crossing} ->
+  {in oe, forall g, left_pt g == p} ->
+  [/\ {in oe, forall g, le <| g}, {in oe, forall g, g <| he} &
+      {in oe &, no_crossing}].
+Proof.
+move=> pl ph lein hein vl vh oesub noc lefts; split.
++ move=> g gin; have := noc _ _ (oesub _ gin) lein.
+  move=>/no_crossingE[]; first by rewrite (eqP (lefts _ _)) // sval.
+  by rewrite (eqP (lefts _ _)) // => _ /(_ pl).
++ move=> g gin; have := noc _ _ (oesub _ gin) hein.
+  move=>/no_crossingE[]; first by rewrite (eqP (lefts _ _)) // sval.
+  by rewrite (eqP (lefts _ _)) // => /(_ ph).
+exact: (sub_in2 oesub).
+Qed.
+
+Lemma common_point_edges_y_left r r1 r2 e1 e2 :
+   valid_edge e1 r -> p_x r <= p_x (left_pt e1) ->
+     p_x r = p_x r1 -> p_x r = p_x r2 -> left_pt e1 === e2 ->
+     r1 === e1 -> r2 === e2 ->
+     p_y r1 = p_y r2.
+Proof.
+move=> v xl rr1 rr2 e1e2 re1 re2.
+have xl': p_x r = p_x (left_pt e1) by apply: le_anti; rewrite xl; case/andP:v.
+have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
+have:= on_edge_same_point (left_on_edge _) re1.
+by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
+Qed.
+
+Lemma common_point_edges_y_right r r1 r2 e1 e2 :
+ valid_edge e1 r -> p_x (right_pt e1) <= p_x r ->
+     p_x r = p_x r1 -> p_x r = p_x r2 -> right_pt e1 === e2 ->
+     r1 === e1 -> r2 === e2 ->
+     p_y r1 = p_y r2.
+Proof.
+move=> v xl rr1 rr2 e1e2 re1 re2.
+have xl': p_x r = p_x (right_pt e1).
+  by apply: le_anti; rewrite xl andbC; case/andP:v.
+have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
+have:= on_edge_same_point (right_on_edge _) re1.
+  by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
+Qed.
+
+Lemma expand_valid p q (pq : p_x p < p_x q) e r :
+  valid_edge (Bedge pq) r ->
+  valid_edge e p -> valid_edge e q -> valid_edge e r.
+Proof.
+move=>/andP[]pr rq /andP[] lep pre /andP[]leq qre; rewrite /valid_edge.
+rewrite /generic_trajectories.valid_edge.
+by rewrite (le_trans lep) ?(le_trans rq).
+Qed.
+
+Lemma keep_under (p q : pt) e1 e2 :
+  inter_at_ext e1 e2 ->
+  {in [:: p; q] & [:: e1; e2], forall r e, valid_edge e r} ->
+  p <<< e1 -> ~~ (p <<< e2) -> ~~(q <<< e1) -> ~~(q <<< e2).
+Proof.
+have left_ext r r1 r2 := @common_point_edges_y_left r r1 r2 e1 e2.
+have right_ext r r1 r2 := @common_point_edges_y_right r r1 r2 e1 e2.
+move=> noc val pue1 pae2 qae1; apply/negP=> que2; set v := valid_edge.
+have : [/\ v e1 p, v e2 p, v e1 q & v e2 q].
+  by split; apply: val; rewrite !inE eqxx ?orbT.
+have pr e r: valid_edge e r ->
+   exists r', [/\ valid_edge e r, r' === e & p_x r = p_x r'].
+    move=>/[dup]vr/exists_point_valid[r' /intersection_on_edge [one xx]].
+    by exists r'; constructor.
+move=>[]/pr[p1 [vp1 pone1 p1p]] /pr[p2 [vp2 pone2 p2p]].
+move=> /pr[q1 [vq1 qone1 q1q]] /pr[q2 [vq2 qone2 q2q]].
+move: vp1 vp2 vq1 vq2 p1p p2p q1q q2q=>vp1 vp2 vq1 vq2 p1p p2p q1q q2q.
+move: pone1 pone2 qone1 qone2=>pone1 pone2 qone1 qone2 {pr v val}.
+set abbrev := strict_under_edge_lower_y.
+have pylt : p_y p < p_y p1 by rewrite -(abbrev _ _ _ _ pone1).
+have pyge : p_y p2 <= p_y p by rewrite leNgt -(abbrev _ _ _ _ pone2).
+have qyge : p_y q1 <= p_y q by rewrite leNgt -(abbrev _ _ _ _ qone1).
+have qylt : p_y q < p_y q2 by rewrite -(abbrev _ _ _ _ qone2).
+have yp : p_y p2 < p_y p1 by rewrite (le_lt_trans pyge).
+have yq : p_y q1 < p_y q2 by rewrite (le_lt_trans qyge).
+move=> {pyge qyge pylt qylt abbrev}.
+have [/[dup]p1p2 + /[dup] q1q2 +] : [/\ p_x p1 == p_x p2 & p_x q1 == p_x q2].
+  by rewrite -p1p p2p -q1q q2q !eqxx.
+move=>/eqP/esym/eqP p2p1 /eqP/esym/eqP q2q1.
+move: (pone1) (pone2) (qone1) (qone2).
+move=>/andP[]pl1 _ /andP[]pl2 _ /andP[]ql1 _ /andP[] ql2 _.
+have [pltq | qltp | pq ] := ltrgtP (p_x p) (p_x q).
+- have [p1q1 p2q2] : p_x p1 < p_x q1 /\ p_x p2 < p_x q2.
+    by rewrite -p1p -q1q -p2p -q2q .
+  set e3 := Bedge p1q1; set e4 := Bedge p2q2.
+  have l3a : ~~(left_pt e3 <<= e4).
+    by move/(@pue_left_edge e4):p2p1=> -> /=; rewrite subr_ge0 -ltNge.
+  have r3u : right_pt e3 <<< e4.
+    by move/(@psue_right_edge e4):q2q1=> -> /=; rewrite subr_lt0.
+  have [pi [pi4 /andP[pi3 piint]]] := intersection_middle_au l3a r3u.
+  have pi1 : pi === e1.
+    apply/andP; split; last first.
+      apply: (expand_valid piint);
+        by rewrite /valid_edge/generic_trajectories.valid_edge -?p1p -?q1q.
+    rewrite -sgr_eq0 (area3_change_ext _ (edge_cond e1) p1q1) //.
+    by rewrite (eqP pi3) /sg !eqxx.
+  have pi2 : pi === e2.
+    apply/andP; split; last first.
+      by apply:(expand_valid piint);
+          rewrite /valid_edge/generic_trajectories.valid_edge -?p1p -?q1q.
+    rewrite -sgr_eq0 (area3_change_ext _ (edge_cond e2) p2q2) //.
+    by rewrite pi4 /sg !eqxx.
+  move: piint; rewrite /valid_edge/generic_trajectories.valid_edge.
+  rewrite /e3/= -p1p -q1q=> /andP[] ppi piq.
+  case: noc=> [E | /(_ pi pi1 pi2) piext]; first by move: pae2; rewrite -E pue1.
+  move: (piext) ppi piq pi1 pi2 { pi3 pi4 }; rewrite !inE.
+  move => /orP[]/eqP/[dup]pival -> ppi piq pi1 pi2.
+    have abs := left_ext _ _ _ vp1 ppi p1p p2p pi2 pone1 pone2.
+    by move: yp; rewrite abs ltxx.
+  have abs := right_ext _ _ _ vq1 piq q1q q2q pi2 qone1 qone2.
+  by move: yq; rewrite abs ltxx.
+- have [q1p1 q2p2] : p_x q1 < p_x p1 /\ p_x q2 < p_x p2.
+    by rewrite -p1p -q1q -p2p -q2q .
+  set e3 := Bedge q1p1; set e4 := Bedge q2p2.
+  have l3u : left_pt e3 <<< e4.
+    by move/(@psue_left_edge e4):q2q1=> -> /=; rewrite subr_gt0.
+  have r3a : right_pt e3 >>> e4.
+    by move/(@pue_right_edge e4):p2p1=> -> /=; rewrite subr_le0 -ltNge.
+  have [pi [pi4 /andP[pi3 piint]]] := intersection_middle_ua l3u r3a.
+  have pi1 : pi === e1.
+    apply/andP; split; last first.
+      by apply: (expand_valid piint); rewrite /valid_edge
+           /generic_trajectories.valid_edge -?p1p -?q1q.
+    rewrite -sgr_eq0 (area3_change_ext _ (edge_cond e1) q1p1) //.
+    by rewrite (eqP pi3) /sg !eqxx.
+  have pi2 : pi === e2.
+    apply/andP; split; last first.
+      by apply:(expand_valid piint);
+        rewrite /valid_edge/generic_trajectories.valid_edge -?p1p -?q1q.
+    rewrite -sgr_eq0 (area3_change_ext _ (edge_cond e2) q2p2) //.
+    by rewrite pi4 /sg !eqxx.
+  move: piint; rewrite /valid_edge/generic_trajectories.valid_edge.
+  rewrite /e3/= -p1p -q1q=> /andP[] qpi pip.
+  case: noc=> [E | /(_ pi pi1 pi2) piext]; first by move: pae2; rewrite -E pue1.
+  move: (piext) qpi pip pi1 pi2 { pi3 pi4 }; rewrite !inE.
+  move => /orP[]/eqP/[dup]pival -> qpi pip pi1 pi2.
+    have abs := left_ext _ _ _ vq1 qpi q1q q2q pi2 qone1 qone2.
+    by move: yq; rewrite abs ltxx.
+  have abs := right_ext _ _ _ vp1 pip p1p p2p pi2 pone1 pone2.
+  by move: yp; rewrite abs ltxx.
+have := conj (on_edge_same_point pone1 qone1) (on_edge_same_point pone2 qone2).
+rewrite -p1p -p2p pq q1q q1q2 !eqxx=> -[]/(_ isT)/eqP p1q1 /(_ isT)/eqP p2q2.
+by move: yp; rewrite p1q1 p2q2; rewrite ltNge le_eqVlt yq orbT.
+Qed.
+
+Definition pvert_y (p : pt) (e : edge) :=
+  match vertical_intersection_point p e with
+    Some p' => p_y p'
+  | None => 0
+  end.
+
+Lemma pvertE p e : valid_edge e p ->
+  vertical_intersection_point p e = Some (Bpt (p_x p) (pvert_y p e)).
+Proof.
+move=> vep; rewrite /pvert_y.
+have [p' p'P] := exists_point_valid vep; rewrite p'P.
+have [one pxq] := intersection_on_edge p'P.
+by rewrite pxq; case: (p') one.
+Qed.
+
+Lemma pvert_on p e : valid_edge e p ->
+  Bpt (p_x p) (pvert_y p e) === e.
+Proof.
+move=> vep; rewrite /pvert_y.
+have [p' p'P] := exists_point_valid vep; rewrite p'P.
+have [one pxq] := intersection_on_edge p'P.
+by rewrite pxq; case: (p') one.
+Qed.
+
+Definition on_pvert p e : p === e -> pvert_y p e = p_y p.
+Proof.
+move=> /[dup]/andP[] _ vpe pone.
+by have := on_edge_same_point pone (pvert_on vpe) (eqxx _) => /eqP ->.
+Qed.
+
+Definition cmp_slopes e1 e2 :=
+  sg((p_y (right_pt e2) - p_y (left_pt e2)) * 
+     (p_x (right_pt e1) -p_x (left_pt e1)) - 
+     (p_y (right_pt e1) - p_y (left_pt e1)) * 
+     (p_x (right_pt e2) - p_x (left_pt e2))).
+
+Definition pedge_below p e1 e2 := 
+  (pvert_y p e1 < pvert_y p e2) || 
+  ((pvert_y p e1 == pvert_y p e2) && (0 <= cmp_slopes e1 e2)).
+
+Definition pedge_below' p e1 e2 := 
+  (pvert_y p e1 < pvert_y p e2) || 
+  ((pvert_y p e1 == pvert_y p e2) && (cmp_slopes e1 e2 <= 0)).
+
+Lemma same_left_edge_below_slopes e1 e2 :
+  left_pt e1 = left_pt e2 ->
+  e1 <| e2 = (0 <= cmp_slopes e1 e2).
+Proof.
+move=> sameleft.
+rewrite /edge_below/point_under_edge !underE [in X in X || _]sameleft.
+rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
+rewrite /point_strictly_under_edge !strictE -[in X in _ || X]sameleft -!leNgt.
+rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
+rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
+rewrite  /cmp_slopes sameleft -opprB oppr_le0.
+rewrite [X in (_ <= X - _) || _]mulrC.
+rewrite [X in _ || (_ <= _ - X)]mulrC.
+rewrite orbb.
+by rewrite sgr_ge0.
+Qed.
+
+Lemma same_right_edge_below_slopes e1 e2 :
+  right_pt e1 = right_pt e2 ->
+  e1 <| e2 = (cmp_slopes e1 e2 <= 0).
+Proof.
+move=> sameright.
+rewrite /edge_below/point_under_edge !underE [in X in X || _]sameright.
+rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /=.
+rewrite /point_strictly_under_edge !strictE -[in X in _ || X]sameright -!leNgt.
+rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /= !andbT.
+rewrite !area3E !(proj2 (pue_f_eq_slopes _ _ _ _ _ _)).
+rewrite /cmp_slopes sameright oppr_le0 opprB.
+rewrite !(mulrC (p_y (right_pt e2) - _)) orbb.
+by rewrite sgr_le0 -oppr_ge0 [X in _ = (0 <= X)]opprB.
+Qed.
+
+Definition slope e :=
+  (p_y (right_pt e) - p_y (left_pt e)) / (p_x (right_pt e) - p_x (left_pt e)).
+
+Lemma cmp_slopesE e1 e2 :
+  cmp_slopes e1 e2 = sg(slope e2 - slope e1).
+Proof.
+have := edge_cond e1.
+  rewrite -subr_gt0 =>/gtr0_sg den1.
+have := edge_cond e2.
+  rewrite -subr_gt0 =>/gtr0_sg den2.
+rewrite -[RHS]mul1r -den1 -[RHS]mul1r -den2 -!sgrM.
+rewrite [X in sg( _ * X)]mulrBr /slope.
+rewrite [X in sg(X)]mulrBr 2![in X in sg(X - _)]mulrA.
+rewrite [X in sg( X * _ * _ - _)]mulrC.
+rewrite 2![in X in sg(_ - X)]mulrA.
+rewrite /cmp_slopes.
+set V := (p_x (right_pt e1) - _).
+set W := (p_x (right_pt e2) - _).
+set U := (p_y _ - _).
+set Z := (p_y _ - _).
+have den20 : W != 0 by rewrite -sgr_eq0 den2 oner_neq0.
+have den10 : V != 0 by rewrite -sgr_eq0 den1 oner_neq0.
+by rewrite (mulrAC V) mulfK // (mulrAC W) mulfK // (mulrC U) (mulrC Z).
+Qed.
+
+Lemma on_edge_same_slope_right e1 e1' :
+  left_pt e1' === e1 -> right_pt e1 = right_pt e1' ->
+  slope e1' = slope e1.
+Proof.
+move=> /andP[]+ val eqr.
+rewrite area3_opposite area3_cycle oppr_eq0.
+rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
+have := edge_cond e1.
+  rewrite -subr_gt0 => den1.
+have := edge_cond e1'.
+  rewrite -subr_gt0 => den1'.
+rewrite subr_eq0.
+set W := (p_x _ - _).
+set V := (p_x _ - _).
+have den10 : W != 0.
+  by rewrite subr_eq0 eq_sym -subr_eq0 lt0r_neq0 // den1.
+have den10v : W ^-1 != 0 by rewrite invr_eq0.
+have den20 : V != 0.
+  by rewrite subr_eq0 eq_sym -subr_eq0 lt0r_neq0 // eqr den1'.
+have den20v : V ^-1 != 0 by rewrite invr_eq0.
+rewrite -(inj_eq (mulIf den10v)) mulfK //.
+rewrite -(inj_eq (mulfI den20v)) 2!mulrA 2!(mulrC V ^-1) divff // mul1r.
+rewrite -[X in X / V]opprB mulNr -mulrN -invrN /V opprB.
+rewrite -[X in X / W]opprB mulNr -mulrN -invrN /V opprB.
+by rewrite /slope eqr=> /eqP.
+Qed.
+
+Lemma on_edge_same_slope_left e1 e1' :
+  right_pt e1' === e1 -> left_pt e1 = left_pt e1' ->
+  slope e1' = slope e1.
+Proof.
+move=> /andP[]+ val eqr.
+rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
+have := edge_cond e1.
+  rewrite -subr_gt0 => den1.
+have := edge_cond e1'.
+  rewrite -subr_gt0 => den1'.
+rewrite subr_eq0.
+set W := (p_x _ - _).
+set V := (p_x _ - _).
+have den10 : W != 0.
+  by rewrite subr_eq0 -subr_eq0 lt0r_neq0 // den1.
+have den10v : W ^-1 != 0 by rewrite invr_eq0.
+have den20 : V != 0.
+  by rewrite subr_eq0 -subr_eq0 lt0r_neq0 // eqr den1'.
+have den20v : V ^-1 != 0 by rewrite invr_eq0.
+rewrite -(inj_eq (mulIf den10v)) mulfK //.
+rewrite -(inj_eq (mulfI den20v)) 2!mulrA 2!(mulrC V ^-1) divff // mul1r.
+by rewrite /slope /W /V eqr=> /eqP.
+Qed.
+
+Lemma cmp_slopesNC e1 e2 : -cmp_slopes e1 e2 = cmp_slopes e2 e1.
+Proof. by rewrite /cmp_slopes -sgrN [in LHS]opprB. Qed.
+
+Lemma contact_left_slope e1 e2 :
+  left_pt e1 === e2 -> 
+  (right_pt e1 <<= e2) = (0 <= cmp_slopes e1 e2) /\
+  (right_pt e1 <<< e2) = (0 < cmp_slopes e1 e2).
+Proof.
+move=> /[dup] on2 /andP[] form val.
+suff area3_eq :
+  sg (area3 (right_pt e1) (left_pt e2) (right_pt e2)) =
+  -(cmp_slopes e1 e2).
+  rewrite /point_under_edge !underE /point_strictly_under_edge !strictE.
+  rewrite -sgr_le0 area3_eq oppr_le0 sgr_ge0; split;[by [] |].
+  by rewrite -sgr_lt0 area3_eq oppr_lt0 sgr_gt0.
+move: (val) => /andP[] _; rewrite le_eqVlt=> /orP[/eqP atr | le1ltre2].
+  rewrite /cmp_slopes atr.
+  have eqps : left_pt e1 = right_pt e2.
+    have := on_edge_same_point (right_on_edge _) on2.
+    rewrite atr eqxx => /(_ isT) /eqP; move: (right_pt e2) (left_pt e1) atr.
+    by move=> [] ? ? [] ? ? /= -> ->.
+  rewrite area3_opposite area3_cycle.
+  rewrite sgrN.
+  rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
+  rewrite -eqps -(mulrC (p_y _ - _)).
+  rewrite -[X in _ = - sg (X * _ - _)]opprB -[X in _ = - sg (_ -  _ * X)]opprB.
+  by rewrite mulrN mulNr -opprD opprB.
+set e2' := Bedge le1ltre2.
+have signcond := area3_change_ext (right_pt e1) (edge_cond e2) le1ltre2
+             form (proj1 (proj2 (area3_two_points _ _))).
+rewrite {}signcond.
+have on2' : left_pt e2' === e2 by exact: on2.
+rewrite cmp_slopesE  -(on_edge_same_slope_right on2')// -cmp_slopesE.
+rewrite cmp_slopesNC.
+rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)) /cmp_slopes.
+by rewrite /e2' /= [in LHS](mulrC (p_x _ - _)).
+Qed.
+
+Lemma contact_right_slope e1 e2 :
+  right_pt e1 === e2 -> 
+  (left_pt e1 <<= e2) = (cmp_slopes e1 e2 <= 0) /\
+  (left_pt e1 <<< e2) = (cmp_slopes e1 e2 < 0).
+Proof.
+move=> /[dup] on2 /andP[] form val.
+suff area3_eq :
+  sg (area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
+  cmp_slopes e1 e2.
+  rewrite /point_under_edge !underE /point_strictly_under_edge !strictE.
+  rewrite -area3_eq -[X in X = _ /\ _]sgr_le0; split; first by [].
+  by rewrite -[LHS]sgr_lt0.
+move: (val) => /andP[] + _; rewrite le_eqVlt eq_sym=> /orP[/eqP atl | le2ltre1].
+  rewrite /cmp_slopes atl.
+  have eqps : right_pt e1 = left_pt e2.
+    have := on_edge_same_point (left_on_edge _) on2.
+    rewrite atl eqxx => /(_ isT) /eqP; move: (right_pt e1) (left_pt e2) atl.
+    by move=> [] ? ? [] ? ? /= -> ->.
+  rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
+  rewrite eqps (mulrC (p_x _ - _)).
+  rewrite -[X in _ = sg (_ * X - _)]opprB -[X in _ = sg (_ -  X * _)]opprB.
+  by rewrite mulrN mulNr -opprD opprB.
+set e2' := Bedge le2ltre1.
+have signcond := area3_change_ext (left_pt e1) (edge_cond e2) le2ltre1
+             (proj1 (area3_two_points _ _)) form.
+rewrite {}signcond.
+have on2' : right_pt e2' === e2 by exact: on2.
+rewrite cmp_slopesE  -(on_edge_same_slope_left on2')// -cmp_slopesE.
+rewrite area3_opposite area3_cycle.
+rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)) /cmp_slopes.
+rewrite /e2' /= [in LHS](mulrC (p_x _ - _)) opprB.
+by rewrite -4![in LHS](opprB (_ (right_pt e1))) 2!mulrNN.
+Qed.
+
+Lemma sub_edge_right (p : pt) (e : edge) : p === e ->
+  p_x p < p_x (right_pt e) ->
+  {e' | [/\ left_pt e' = p, right_pt e' = right_pt e &
+        forall e2, cmp_slopes e' e2 = cmp_slopes e e2]}.
+Proof.
+move=>/[dup] one /andP[] aligned val dif; exists (Bedge dif).
+split => // e2; rewrite !cmp_slopesE.
+by rewrite (@on_edge_same_slope_right e (Bedge dif) one erefl).
+Qed.
+
+Lemma sub_edge_left (p : pt) (e : edge) : p === e ->
+  p_x (left_pt e) < p_x p ->
+  {e' | [/\ left_pt e' = left_pt e, right_pt e' = p &
+        forall e2, cmp_slopes e' e2 = cmp_slopes e e2]}.
+Proof.
+move=>/[dup] one /andP[] aligned val dif; exists (Bedge dif).
+split => // e2; rewrite !cmp_slopesE.
+by rewrite (@on_edge_same_slope_left e (Bedge dif) one erefl).
+Qed.
+
+Lemma intersection_imp_crossing e1 e2 p :
+  p === e1 -> p === e2 ->
+  p_x (left_pt e1) < p_x p -> p_x p < p_x (right_pt e1) ->
+  p_x (left_pt e2) < p_x p -> p_x p < p_x (right_pt e2) ->
+  ~below_alt e1 e2 \/ cmp_slopes e1 e2 == 0.
+Proof.
+move=> on1 on2 l1ltp pltr1 l2ltp pltr2.
+have [e2' [le2' re2' sle2']] := sub_edge_left on2 l2ltp.
+have [e2'' [le2'' re2'' sle2'']] := sub_edge_right on2 pltr2.
+have [e1' [le1' re1' sle1']] := sub_edge_left on1 l1ltp.
+have [e1'' [le1'' re1'' sle1'']] := sub_edge_right on1 pltr1.
+have /contact_left_slope/= : left_pt e2'' === e1 by rewrite le2''.
+have /contact_right_slope/= : right_pt e2' === e1 by rewrite re2'.
+have /contact_left_slope/= : left_pt e1'' === e2 by rewrite le1''.
+have /contact_right_slope/= : right_pt e1' === e2 by rewrite re1'.
+rewrite le1' le2' re2'' re1'' sle1' sle1'' sle2' sle2'' -(cmp_slopesNC e1).
+rewrite !oppr_lte0 !oppr_gte0 => -[]D' D []C' C []B' B []A' A.
+rewrite /below_alt/edge_below.
+have [ | difslope] := boolP(cmp_slopes e1 e2 == 0); first by right.
+left; rewrite D' C' A B A' B' D C -!leNgt orbC=> /orP; rewrite andbC !orbb.
+by move/le_anti/esym/eqP; rewrite (negbTE difslope).
+Qed.
+
+Lemma order_below_viz_vertical low_e high_e p pl ph:
+valid_edge low_e p -> valid_edge high_e p ->
+vertical_intersection_point p low_e = Some pl ->
+vertical_intersection_point p high_e = Some ph ->
+low_e <| high_e ->
+p_y pl <= p_y ph.
+Proof.
+move => lowv highv vert_pl vert_ph luh.
+have := intersection_on_edge vert_pl => [][] poel lx_eq.
+have := intersection_on_edge vert_ph => [][] poeh hx_eq.
+have plhv: valid_edge high_e pl.
+  move : highv.
+  by rewrite /valid_edge/generic_trajectories.valid_edge -lx_eq.
+have pllv: valid_edge low_e pl.
+  move : lowv.
+  by rewrite /valid_edge/generic_trajectories.valid_edge -lx_eq.
+have := order_edges_viz_point' pllv  plhv luh.
+rewrite under_onVstrict // poel /= => [] /= plinfh.
+have pluh: pl <<= high_e .
+  by apply plinfh.
+have px_eq : p_x pl = p_x ph.
+  by rewrite -lx_eq -hx_eq /=.
+by rewrite -(under_edge_lower_y px_eq poeh).
+Qed.
+
+Lemma edge_below_equiv p (s : pred edge) :
+  {in s, forall e, valid_edge e p && (p_x p < p_x (right_pt e))} ->
+  {in s &, no_crossing} ->
+  {in s & , forall e1 e2: edge, (e1 <| e2) = pedge_below p e1 e2}.
+Proof.
+move=> val noc e1 e2.
+move=> /[dup] e1in /val /andP[] /[dup] ve1 /exists_point_valid [p1 p1P] re1.
+move: (p1P); rewrite (pvertE ve1) =>/esym[] p1q.
+move: (ve1)=> /pvert_on; rewrite -p1q=> on1.
+move=> /[dup] e2in /val /andP[] /[dup] ve2 /exists_point_valid [p2 p2P] re2.
+move: (p2P); rewrite (pvertE ve2) =>/esym[] p2q.
+move: (ve2)=> /pvert_on; rewrite -p2q=> on2; rewrite /pedge_below.
+have p1p2 : p_x p1 = p_x p2 by rewrite p1q p2q.
+have [vylt /= | vylt' /= | vyq] := ltrgtP.
+- case: (noc e1 e2 e1in e2in) => // abs.
+  have := order_below_viz_vertical ve2 ve1 p2P p1P abs; rewrite leNgt.
+  by rewrite p1q p2q /= vylt.
+- have re1' : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+  have p2u : p2 <<< e1.
+    by rewrite (strict_under_edge_lower_y (esym p1p2)); rewrite // p2q p1q.
+  have p1a : p1 >>> e2.
+    by rewrite (under_edge_lower_y p1p2); rewrite // -ltNge p2q p1q.
+  apply/negP=> /orP[|] /andP[]leftc rightc.
+    by move: p1a; rewrite (point_on_edge_under _ leftc rightc) // p1q.
+  move: p2u; rewrite -(negbK (_ <<< _)).
+  by rewrite (point_on_edge_above _ leftc rightc) // p2q.
+have pp : p1 = p2 by rewrite p1q p2q vyq.
+move: (ve1) => /andP[] + _; rewrite le_eqVlt=>/orP[/eqP pleft | pmid] /=.
+  have p1l : p1 = left_pt e1.
+    apply/esym/eqP; rewrite pt_eqE.
+    by rewrite (on_edge_same_point (left_on_edge _) on1) pleft p1q eqxx.
+  move: ve2 => /andP[] + _; rewrite le_eqVlt=> /orP [/eqP pleft2 | pmid2].
+    have p2l : p2 = left_pt e2.
+      apply/esym/eqP; rewrite pt_eqE.
+      by rewrite (on_edge_same_point (left_on_edge _) on2) pleft2 p2q eqxx.
+    by apply: same_left_edge_below_slopes; rewrite -p1l pp.
+  have le2ltp2 : p_x (left_pt e2) < p_x p2 by rewrite p2q.
+  have [e2' [le2' re2' sle2']] := sub_edge_left on2 le2ltp2.
+  have re2'e1 : right_pt e2' === e1 by rewrite re2' -pp.
+  rewrite /edge_below.
+  have := (contact_right_slope re2'e1) => /= -[] _; rewrite le2' sle2' => ->.
+  have p2ltre2 : p_x p2 < p_x (right_pt e2) by rewrite p2q.
+  have [e2'' [le2'' re2'' sle2'']] := sub_edge_right on2 p2ltre2.
+  have le2''e1 : left_pt e2'' === e1 by rewrite le2'' -pp.
+  have := (contact_left_slope le2''e1) => -[] _; rewrite re2'' sle2'' => ->.
+  rewrite -2!leNgt.
+  set W := (X in _ || X); have [ | difslope] := boolP W.
+    rewrite {}/W=>/le_anti/esym=>/eqP.
+    by rewrite -cmp_slopesNC oppr_eq0 orbT=> /eqP->; rewrite lexx.
+  rewrite orbF -p1l pp {1}/point_under_edge underE.
+  move: (on2); rewrite /point_on_edge.
+  move=> /andP[] /eqP -> _; rewrite lexx /=.
+  by move: (on2); rewrite -pp p1l=>/contact_left_slope=>-[].
+have le1ltp1 : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+have [e1' [le1' re1' sle1']] := sub_edge_left on1 le1ltp1.
+have re1'e2 : right_pt e1' === e2 by rewrite re1' pp.
+rewrite /edge_below.
+set W := (X in X || _); set W' := (X in _ || X).
+have := (contact_right_slope re1'e2); rewrite le1' sle1' => /= -[] eq1 _.
+have p1ltre1 : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+have [e1'' [le1'' re1'' sle1'']] := sub_edge_right on1 p1ltre1.
+have le1''e2 : left_pt e1'' === e2 by rewrite le1'' pp.
+have /= := (contact_left_slope le1''e2); rewrite re1'' sle1'' => - [] /= eq2 _.
+have Weq : W = (cmp_slopes e1 e2 == 0).
+  rewrite /W eq1 eq2; apply/idP/eqP; first by apply/le_anti.
+  by move=> ->; rewrite lexx.
+have [ | difslope /=] := boolP W.
+  by rewrite /= le_eqVlt Weq => /eqP ->; rewrite eqxx.
+rewrite le_eqVlt eq_sym -Weq (negbTE difslope) /=.
+move: (ve2) => /andP[] + _; rewrite le_eqVlt => /orP [/eqP l2p | l2ltp].
+  have /eqP p2l : left_pt e2 == p1.
+    rewrite pt_eqE.
+    rewrite (eqP (on_edge_same_point (left_on_edge _) on2 _)) -pp l2p p1q //=.
+    by rewrite !eqxx.
+  have/contact_left_slope[_ eq3] : left_pt e2 === e1 by rewrite p2l.
+  move: on1=>/andP[] /eqP + _; rewrite -p2l => eq4.
+  rewrite /W' eq3 lt_neqAle -cmp_slopesNC eq_sym oppr_eq0 -Weq difslope andTb.
+  rewrite /point_strictly_under_edge strictE.
+  by rewrite -leNgt eq4 lexx -ltNge oppr_lt0.
+have xpp1 : p_x p = p_x p1 by rewrite p1q.
+move: on2 l2ltp re2; rewrite -pp xpp1 => on2 l2ltp re2.
+have := intersection_imp_crossing on1 on2 le1ltp1 p1ltre1 l2ltp re2=> -[[]|abs].
+  by apply: noc.
+by case/negP: difslope; rewrite Weq.
+Qed.
+
+Lemma edge_below_equiv' p (s : pred edge) :
+  {in s, forall e, valid_edge e p && (p_x (left_pt e) < p_x p)} ->
+  {in s &, no_crossing} ->
+  {in s & , forall e1 e2: edge, (e1 <| e2) = pedge_below' p e1 e2}.
+Proof.
+move=> val noc e1 e2.
+move=> /[dup] e1in /val /andP[] /[dup] ve1 /exists_point_valid [p1 p1P] le1.
+move: (p1P); rewrite (pvertE ve1) =>/esym[] p1q.
+move: (ve1)=> /pvert_on; rewrite -p1q=> on1.
+move=> /[dup] e2in /val /andP[] /[dup] ve2 /exists_point_valid [p2 p2P] le2.
+move: (p2P); rewrite (pvertE ve2) =>/esym[] p2q.
+move: (ve2)=> /pvert_on; rewrite -p2q=> on2; rewrite /pedge_below'.
+have p1p2 : p_x p1 = p_x p2 by rewrite p1q p2q.
+have [vylt /= | vylt' /= | vyq] := ltrgtP.
+- case: (noc e1 e2 e1in e2in) => // abs.
+  have := order_below_viz_vertical ve2 ve1 p2P p1P abs; rewrite leNgt.
+  by rewrite p1q p2q /= vylt.
+- have le1' : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+  have p2u : p2 <<< e1.
+    by rewrite (strict_under_edge_lower_y (esym p1p2)); rewrite // p2q p1q.
+  have p1a : p1 >>> e2.
+    by rewrite (under_edge_lower_y p1p2); rewrite // -ltNge p2q p1q.
+  apply/negP=> /orP[|] /andP[]leftc rightc.
+    by move: p1a; rewrite (point_on_edge_under _ leftc rightc) // p1q.
+  move: p2u; rewrite -(negbK (_ <<< _)).
+  by rewrite (point_on_edge_above _ leftc rightc) // p2q.
+have pp : p1 = p2 by rewrite p1q p2q vyq.
+move: (ve1) => /andP[] _ +; rewrite le_eqVlt=>/orP[/eqP pright | pmid] /=.
+  have p1r : p1 = right_pt e1.
+    apply/eqP; rewrite pt_eqE.
+    by rewrite (on_edge_same_point on1 (right_on_edge _)) -pright p1q eqxx.
+  move: ve2 => /andP[] _; rewrite le_eqVlt=> /orP [/eqP pright2 | pmid2].
+    have p2l : p2 = right_pt e2.
+      apply/eqP; rewrite pt_eqE.
+      by rewrite (on_edge_same_point on2 (right_on_edge _)) -pright2 p2q eqxx.
+    by apply: same_right_edge_below_slopes; rewrite -p1r pp.
+  have p2ltre2 : p_x p2 < p_x (right_pt e2) by rewrite p2q.
+  have [e2' [le2' re2' sle2']] := sub_edge_right on2 p2ltre2.
+  have le2'e1 : left_pt e2' === e1 by rewrite le2' -pp.
+  rewrite /edge_below.
+  have := (contact_left_slope le2'e1) => /= -[] _; rewrite re2' sle2' => ->.
+  have le2ltp2 : p_x (left_pt e2) < p_x p2 by rewrite p2q.
+  have [e2'' [le2'' re2'' sle2'']] := sub_edge_left on2 le2ltp2.
+  have re2''e1 : right_pt e2'' === e1 by rewrite re2'' -pp.
+  have := (contact_right_slope re2''e1) => -[] _; rewrite le2'' sle2'' => ->.
+  rewrite -2!leNgt.
+  set W := (X in _ || X); have [ | difslope] := boolP W.
+    rewrite {}/W=>/le_anti/esym/eqP.
+    by rewrite -cmp_slopesNC oppr_eq0 orbT=> /eqP->; rewrite lexx.
+  rewrite orbF -p1r pp {2}/point_under_edge underE.
+   move: (on2); rewrite /point_on_edge.
+  move=> /andP[] /eqP -> _; rewrite lexx andbT.
+  by move: (on2); rewrite -pp p1r=>/contact_right_slope=>-[].
+have p1ltre1 : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+have [e1' [le1' re1' sle1']] := sub_edge_right on1 p1ltre1.
+have le1'e2 : left_pt e1' === e2 by rewrite le1' pp.
+rewrite /edge_below.
+set W := (X in X || _); set W' := (X in _ || X).
+have := (contact_left_slope le1'e2); rewrite re1' sle1' => /= -[] eq1 _.
+have le1ltp1 : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+have [e1'' [le1'' re1'' sle1'']] := sub_edge_left on1 le1ltp1.
+have re1''e2 : right_pt e1'' === e2 by rewrite re1'' pp.
+have /= := (contact_right_slope re1''e2); rewrite le1'' sle1'' => - [] /= eq2 _.
+have Weq : W = (cmp_slopes e1 e2 == 0).
+  rewrite /W eq1 eq2; apply/idP/eqP; first by apply/le_anti.
+  by move=> ->; rewrite lexx.
+have [ | difslope /=] := boolP W.
+  by rewrite /= le_eqVlt Weq => /eqP ->; rewrite eqxx.
+rewrite le_eqVlt -Weq (negbTE difslope) /=.
+move: (ve2) => /andP[] _; rewrite le_eqVlt => /orP [/eqP r2p | pltr2].
+  have /eqP p2r : right_pt e2 == p1.
+    rewrite pt_eqE.
+    rewrite -(eqP (on_edge_same_point on2 (right_on_edge _) _)) -pp -r2p p1q //=.
+    by rewrite !eqxx.
+  have/contact_right_slope[_ eq3] : right_pt e2 === e1 by rewrite p2r.
+  move: on1=>/andP[] /eqP + _; rewrite -p2r => eq4.
+  rewrite /W' eq3 lt_neqAle -cmp_slopesNC oppr_eq0 -Weq difslope andTb.
+  by rewrite /W' /point_strictly_under_edge strictE
+      eq4 ltxx andbT -ltNge oppr_gt0.
+have xpp1 : p_x p = p_x p1 by rewrite p1q.
+move: on2 pltr2 le2; rewrite -pp xpp1 => on2 pltr2 le2.
+have := intersection_imp_crossing on1 on2 le1ltp1 p1ltre1 le2 pltr2=> -[[]|abs].
+  by apply: noc.
+by case/negP: difslope; rewrite Weq.
+Qed.
+
+Lemma pedge_below_trans p: transitive (pedge_below p).
+Proof.
+move=> e2 e1 e3; rewrite /pedge_below.
+move=>/orP[v12 | /andP [y12 s12]] /orP[v23 | /andP[y23 s23]].
+- by rewrite (lt_trans v12 v23).
+- by rewrite -(eqP y23) v12.
+- by rewrite (eqP y12) v23.
+rewrite orbC (eqP y12) y23.
+move: s12 s23; rewrite !cmp_slopesE !sgr_ge0 !subr_ge0=> s12 s23.
+by rewrite (le_trans s12 s23).
+Qed.
+
+Lemma pedge_below_trans' p: transitive (pedge_below' p).
+Proof.
+move=> e2 e1 e3; rewrite /pedge_below'.
+move=>/orP[v12 | /andP [y12 s12]] /orP[v23 | /andP[y23 s23]].
+- by rewrite (lt_trans v12 v23).
+- by rewrite -(eqP y23) v12.
+- by rewrite (eqP y12) v23.
+rewrite orbC (eqP y12) y23.
+move: s12 s23; rewrite !cmp_slopesE !sgr_le0.
+rewrite (subr_le0 (slope e1)) (subr_le0 (slope e2)) (subr_le0 (slope e1)).
+by move=> s12 s23; rewrite (le_trans s23 s12).
+Qed.
+
+Lemma edge_below_trans p (s : pred edge) :
+  {in s, forall e, p_x p < p_x (right_pt e)} \/ 
+  {in s, forall e, p_x (left_pt e) < p_x p} ->
+  {in s, forall e, valid_edge e p} -> {in s &, no_crossing} ->
+  {in s & & , transitive edge_below}.
+Proof.
+move=> [rbound | lbound] vals noc e2 e1 e3 e2in e1in e3in.
+  have valb : {in s, forall e, valid_edge e p && (p_x p < p_x (right_pt e))}.
+    by move=> e ein; apply/andP; split;[apply: vals | apply: rbound].
+  rewrite (edge_below_equiv valb noc) // (edge_below_equiv valb noc) //.
+  rewrite (edge_below_equiv valb noc) //.
+  by apply: pedge_below_trans.
+have valb : {in s, forall e, valid_edge e p && (p_x (left_pt e) < p_x p)}.
+  by move=> e ein; apply/andP; split;[apply: vals | apply: lbound].
+rewrite (edge_below_equiv' valb noc) // (edge_below_equiv' valb noc) //.
+rewrite (edge_below_equiv' valb noc) //.
+by apply: pedge_below_trans'.
+Qed.
+
+
+Lemma left_pt_above g : left_pt g >>= g.
+Proof.
+rewrite /point_strictly_under_edge strictE.
+rewrite (eqP (proj1 (area3_two_points _ _))).
+by rewrite ltxx.
+Qed.
+
+Lemma right_pt_above g : right_pt g >>= g.
+Proof.
+rewrite /point_strictly_under_edge strictE.
+by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) ltxx.
+Qed.
+
+Lemma left_pt_below g : left_pt g <<= g.
+Proof.
+rewrite /point_under_edge underE (eqP (proj1 (area3_two_points _ _))).
+by rewrite lexx.
+Qed.
+
+Lemma right_pt_below g : right_pt g <<= g.
+Proof.
+rewrite /point_under_edge underE.
+by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
+Qed.
+
+Lemma under_pvert_y (p : pt) (e : edge) :
+  valid_edge e p -> (p <<= e) = (p_y p <= pvert_y p e).
+Proof.
+move=> val.
+have xs : p_x p = p_x (Bpt (p_x p) (pvert_y p e)) by [].
+have one : Bpt (p_x p) (pvert_y p e) === e by apply: pvert_on.
+by rewrite (under_edge_lower_y xs one).
+Qed.
+
+Lemma strict_under_pvert_y (p : pt) (e : edge) :
+  valid_edge e p -> (p <<< e) = (p_y p < pvert_y p e).
+Proof.
+move=> val.
+have xs : p_x p = p_x (Bpt (p_x p) (pvert_y p e)) by [].
+have one : Bpt (p_x p) (pvert_y p e) === e by apply: pvert_on.
+by rewrite (strict_under_edge_lower_y xs one).
+Qed.
+
+Lemma same_x_valid (p1 p2 : pt) (g : edge) :
+  p_x p1 == p_x p2 -> valid_edge g p1 = valid_edge g p2.
+Proof.
+by move=> /eqP xs; rewrite /valid_edge/generic_trajectories.valid_edge xs.
+Qed.
+
+Lemma same_pvert_y (p1 p2 : pt) (g : edge) :
+  valid_edge g p1 ->
+  p_x p1 == p_x p2 -> pvert_y p1 g = pvert_y p2 g.
+Proof.
+move=> vg xs; apply/eqP.
+move: (vg) ; rewrite (same_x_valid _ xs) => vg2.
+by have := on_edge_same_point (pvert_on vg) (pvert_on vg2) xs.
+Qed.
+
+Lemma edge_below_pvert_y g1 g2 p :
+  valid_edge g1 p -> valid_edge g2 p ->
+  g1 <| g2 -> pvert_y p g1 <= pvert_y p g2.
+Proof.
+move=> v1 v2 g1g2.
+have := pvert_on v1; set p' := Bpt _ _ => p'on.
+have/esym := @same_x_valid p p' g1 (eqxx _); rewrite v1 => v'1.
+have/esym := @same_x_valid p p' g2 (eqxx _); rewrite v2 => v'2.
+have := order_edges_viz_point' v'1 v'2 g1g2.
+rewrite (under_onVstrict v'1) p'on => /(_ isT).
+by rewrite under_pvert_y //.
+Qed.
+
+Lemma pvert_y_edge_below g1 g2 p :
+  valid_edge g1 p -> valid_edge g2 p ->
+  pvert_y p g1 < pvert_y p g2 -> ~~ (g2 <| g1).
+Proof.
+move=> v1 v2 cmp; apply/negP=> g2g1.
+have := edge_below_pvert_y v2 v1 g2g1.
+by rewrite leNgt cmp.
+Qed.
+
+Lemma edges_partition_strictly_above p g1 g2 s1 s2:
+  all (valid_edge^~ p) (s1 ++ g1 :: g2 :: s2) ->
+  sorted edge_below (s1 ++ g1 :: g2 :: s2) ->
+  p >>= g1 -> p <<< g2 ->
+  {in rcons s1 g1 &  g2 :: s2, forall g g', ~~ (g' <| g)}.
+Proof.
+move=> aval pth pg1 pg2.
+have vg1 : valid_edge g1 p.
+  by apply: (allP aval); rewrite !(mem_cat, inE) eqxx ?orbT.
+have vg2 : valid_edge g2 p.
+  by apply: (allP aval); rewrite !(mem_cat, inE) eqxx ?orbT.
+have pg1y : pvert_y p g1 <= p_y p by rewrite leNgt -strict_under_pvert_y.
+have pg2y : p_y p < pvert_y p g2 by rewrite -strict_under_pvert_y.
+have g1g2 : pvert_y p g1 < pvert_y p g2 by apply: (le_lt_trans pg1y).
+have mp : {in s1++ g1 :: g2 :: s2 &,
+           {homo (pvert_y p) : x y / x <| y >-> x <= y}}.
+    move=> u v /(allP aval) vu /(allP aval) vv uv.
+    by apply: edge_below_pvert_y vu vv uv.
+have sb2 : {subset [:: g1, g2 & s2] <= (s1 ++ [:: g1, g2 & s2])}.
+  by move=> u uin; rewrite mem_cat uin orbT.
+have g2s2y : {in g2 :: s2, forall g, pvert_y p g1 < pvert_y p g}.
+  move=> g; rewrite inE => /orP[/eqP -> //| gin].
+  have pthy : sorted <=%R [seq pvert_y p h | h <- g2 :: s2].
+    apply: (homo_path_in mp); last first.
+      move: pth.
+      rewrite (_ : s1 ++ _ = (s1 ++[:: g1]) ++ g2 :: s2); last first.
+        by rewrite /= -!catA.
+      by move/sorted_catW=> /andP[].
+    apply: (sub_all sb2).
+    by apply/allP => z; rewrite !(mem_cat, inE) => /orP[] ->; rewrite ?orbT.
+  have /(allP aval) gin' : g \in (s1 ++ [:: g1, g2 & s2]).
+    by rewrite mem_cat !inE gin ?orbT.
+  move: pthy; rewrite /= (path_sortedE le_trans) => /andP[] /allP.
+  have giny : pvert_y p g \in [seq pvert_y p h | h <- s2] by apply: map_f.
+  by move=> /(_ _ giny) => /(lt_le_trans g1g2).
+have sb1 : {subset rcons s1 g1 <= s1 ++ [:: g1, g2 & s2]}.
+  by move=> x; rewrite mem_rcons mem_cat !inE => /orP[] ->; rewrite ?orbT.
+have s1g1y : {in rcons s1 g1, forall g, pvert_y p g <= pvert_y p g1}.
+  move=> g; rewrite mem_rcons inE => /orP[/eqP ->| gin].
+    apply: le_refl.
+  case s1eq : s1 gin => [// | init s1']; rewrite -s1eq => gin.
+  have pthy : sorted <=%R [seq pvert_y p h | h <- rcons s1 g1].
+    rewrite s1eq /=; apply: (homo_path_in mp); last first.
+      move: pth; rewrite s1eq/=.
+      rewrite (_ : s1' ++ _ = (s1' ++ [:: g1]) ++ g2 :: s2); last first.
+        by rewrite -catA.
+      by rewrite cat_path cats1 => /andP[].
+    by apply: (sub_all sb1); rewrite s1eq; apply: allss.
+  have [s' [s'' s'eq]] : exists s' s'', s1 = s' ++ g :: s''.
+    by move: gin=> /splitPr [s' s'']; exists s', s''.
+  have dc : rcons (init :: s1') g1 = (s' ++ [:: g]) ++ rcons s'' g1.
+   by rewrite -s1eq s'eq -!cats1 /= -?catA.
+  case s'eq2 : s' => [ | init' s'2].
+    move: pthy; rewrite s1eq dc s'eq2 /= (path_sortedE le_trans)=> /andP[].
+    move=> /allP/(_ (pvert_y p g1)) + _; apply.
+    by rewrite map_f // mem_rcons inE eqxx.
+  move: pthy; rewrite s1eq dc s'eq2 /= map_cat cat_path => /andP[] _.
+  rewrite !map_cat cats1 last_rcons (path_sortedE le_trans) => /andP[] + _.
+  move=> /allP/(_ (pvert_y p g1)); apply.
+  by apply: map_f; rewrite mem_rcons inE eqxx.
+move=> g g' /[dup]gin /s1g1y giny /[dup] g'in /g2s2y g'iny; apply/negP=> g'g.
+have vg : valid_edge g p by apply: (allP aval); apply: sb1.
+have vg' : valid_edge g' p.
+  by apply: (allP aval); apply: sb2; rewrite inE g'in orbT.
+have:= edge_below_pvert_y vg' vg g'g; rewrite leNgt.
+by rewrite (le_lt_trans _ g'iny).
+Qed.
+
+Lemma edge_below_from_point_above g1 g2 p:
+  below_alt g1 g2 -> valid_edge g1 p -> valid_edge g2 p ->
+  p >>= g1 -> p <<< g2 -> g1 <| g2.
+Proof.
+move=>[] //= g2g1 v1 v2 ab bel.
+have := order_edges_strict_viz_point' v2 v1 g2g1 bel.
+by rewrite (negbTE ab).
+Qed.
+
+Lemma edge_below_from_point_under g1 g2 p:
+  below_alt g1 g2 -> valid_edge g1 p -> valid_edge g2 p ->
+  p <<= g1 -> p >>> g2 -> g2 <| g1.
+Proof.
+move=>/below_altC[] //=g1g2 v1 v2 bel ab.
+have := order_edges_viz_point' v1 v2 g1g2 bel.
+by rewrite (negbTE ab).
+Qed.
+
+Lemma transport_below_edge r p e e':
+  below_alt e e' ->
+  valid_edge e r -> valid_edge e' r ->
+  valid_edge e p -> valid_edge e' p ->
+  pvert_y r e < pvert_y r e' ->
+  p <<< e -> p <<< e'.
+Proof.
+move=> noc vr vr' vp vp' cmp pbelow.
+have ebe'0 := pvert_y_edge_below vr vr' cmp.
+have ebe' : e <| e' by case: noc ebe'0=> [// | -> ].
+by apply:(order_edges_strict_viz_point' vp vp').
+Qed.
+
+Lemma transport_above_edge r p e e':
+  below_alt e e' ->
+  valid_edge e r -> valid_edge e' r ->
+  valid_edge e p -> valid_edge e' p ->
+  pvert_y r e < pvert_y r e' ->
+  p >>> e' -> p >>> e.
+Proof.
+move=> noc vr vr' vp vp' cmp pabove.
+have ebe'0 := pvert_y_edge_below vr vr' cmp.
+have ebe' : e <| e' by case: noc ebe'0=> [// | -> ].
+apply/negP=> abs.
+by move: pabove; rewrite (order_edges_viz_point' vp vp').
+Qed.
+
+Lemma path_edge_below_pvert_y bottom s p :
+  all (valid_edge^~ p) (bottom :: s) ->
+  path edge_below bottom s -> path <=%R (pvert_y p bottom)
+  [seq pvert_y p e | e <- s].
+Proof.
+move=> aval.
+have hp : {in bottom :: s &,
+         {homo (pvert_y p) : u v / edge_below u v >-> u <= v}}.
+  move=> u v /(allP aval) vu /(allP aval) vv.
+    by apply: edge_below_pvert_y vu vv.
+by move/(homo_path_in hp)=> /(_ (allss (bottom :: s))).
+Qed.
+
+Lemma edge_below_gap bottom s s' le r p g g' : 
+{in bottom::rcons s le ++ s' &, no_crossing} ->
+all (valid_edge^~ r) (bottom :: rcons s le ++ s') ->
+path edge_below bottom (rcons s le ++ s') ->
+r >>> le -> r <<= g' ->
+g \in rcons s le ->
+valid_edge g p ->
+p >>> g' ->
+g' \in s' ->
+valid_edge g' p -> p >>> g.
+Proof.
+move=> noc aval pth rabove rbelow gin vp pabove g'in vp'.
+have gin2 : g \in bottom :: rcons s le ++ s'.
+  by move: gin; rewrite !(inE, mem_rcons, mem_cat)=>/orP[] ->; rewrite ?orbT.
+have g'in2 : g' \in bottom :: rcons s le ++ s'.
+  by move: g'in; rewrite !(inE, mem_rcons, mem_cat)=> ->; rewrite ?orbT.
+have lein : le \in bottom :: rcons s le ++ s'.
+  by rewrite !(inE, mem_cat, mem_rcons) eqxx ?orbT.
+have vl : valid_edge le r by apply: (allP aval).
+have vr : valid_edge g r by apply: (allP aval).
+have vr' : valid_edge g' r by apply: (allP aval).
+have noc' : below_alt g g' by apply: noc.
+apply: (transport_above_edge noc' vr) => //.
+have aval' : all (valid_edge^~ r) (bottom :: rcons s le).
+  apply/allP=> u uin; apply: (allP aval).
+  move: uin; rewrite !(inE, mem_cat, mem_rcons).
+  by move=> /orP[| /orP[]] ->; rewrite ?orbT.
+have aval'' : all (valid_edge^~ r) (le :: s'). 
+  apply/allP=> u uin; apply: (allP aval).
+  move: uin; rewrite !(inE, mem_cat, mem_rcons).
+  by move=> /orP[] ->; rewrite ?orbT.
+have tr : transitive (relpre (pvert_y r) <=%R).
+  by move=> y x z; rewrite /=; apply: le_trans.
+have le_g' : pvert_y r le < pvert_y r g'.
+  have le_r : pvert_y r le < p_y r by rewrite ltNge -under_pvert_y.
+  have r_g' : p_y r <= pvert_y r g' by rewrite -under_pvert_y.
+  by apply: lt_le_trans le_r r_g'.
+have g_le : pvert_y r g <= pvert_y r le.
+  move: gin; rewrite mem_rcons inE=> /orP[/eqP -> |gin]; first by rewrite lexx.
+  have gin' : g \in (bottom :: s) by rewrite inE gin orbT.
+  move: pth; rewrite cat_path last_rcons => /andP[] + _.
+  move=> /= /path_edge_below_pvert_y => /(_ _ aval').
+  rewrite path_map.
+  rewrite -[path _ _ _]/(sorted _ (rcons (bottom :: s) le)).
+  by move=> /(sorted_rconsE tr)/allP/(_ _ gin') /=.
+by apply: le_lt_trans le_g'.
+Qed.
+
+Lemma edge_above_gap bottom s s' he r p g g' : 
+{in bottom::rcons s he ++ s' &, no_crossing} ->
+all (valid_edge^~ r) (bottom :: rcons s he ++ s') ->
+path edge_below bottom (rcons s he ++ s') ->
+r <<< he -> r >>= g ->
+g \in rcons s he ->
+valid_edge g p ->
+p <<< g ->
+g' \in s' ->
+valid_edge g' p -> p <<< g'.
+Proof.
+move=> noc aval pth rabove rbelow gin vp pabove g'in vp'.
+have gin2 : g \in bottom :: rcons s he ++ s'.
+  by move: gin; rewrite !(inE, mem_rcons, mem_cat)=>/orP[] ->; rewrite ?orbT.
+have g'in2 : g' \in bottom :: rcons s he ++ s'.
+  by move: g'in; rewrite !(inE, mem_rcons, mem_cat)=> ->; rewrite ?orbT.
+have hein : he \in bottom :: rcons s he ++ s'.
+  by rewrite !(inE, mem_cat, mem_rcons) eqxx ?orbT.
+have vl : valid_edge he r by apply: (allP aval).
+have vr : valid_edge g r by apply: (allP aval).
+have vr' : valid_edge g' r by apply: (allP aval).
+have noc' : below_alt g g' by apply: noc.
+apply: (transport_below_edge noc' vr) => //.
+have aval' : all (valid_edge^~ r) (bottom :: rcons s he).
+  apply/allP=> u uin; apply: (allP aval).
+  move: uin; rewrite !(inE, mem_cat, mem_rcons).
+  by move=> /orP[| /orP[]] ->; rewrite ?orbT.
+have aval'' : all (valid_edge^~ r) (he :: s'). 
+  apply/allP=> u uin; apply: (allP aval).
+  move: uin; rewrite !(inE, mem_cat, mem_rcons).
+  by move=> /orP[] ->; rewrite ?orbT.
+have tr : transitive (relpre (pvert_y r) <=%R).
+  by move=> y x z; rewrite /=; apply: le_trans.
+have g_he : pvert_y r g < pvert_y r he.
+  have r_he : p_y r < pvert_y r he by rewrite -strict_under_pvert_y.
+  have g_r : pvert_y r g <= p_y r by rewrite leNgt -strict_under_pvert_y.
+  by apply: le_lt_trans g_r r_he.
+have he_g' : pvert_y r he <= pvert_y r g'.
+  move: pth; rewrite cat_path last_rcons => /andP[] _.
+  move=> /= /path_edge_below_pvert_y => /(_ _ aval'').
+  rewrite path_map /=.
+  by rewrite (path_sortedE tr) => /andP[] /allP/(_ _ g'in) /=.
+by apply: lt_le_trans he_g'.
+Qed.
+
+Definition non_inner (g : edge) (p : pt) :=
+  p === g -> p = left_pt g \/ p = right_pt g.
+
+End working_context.
+
+Notation "p '<<=' e" := (point_under_edge p e)( at level 70, no associativity).
+Notation "p '<<<' e" := (point_strictly_under_edge p e)(at level 70, no associativity).
+
+Notation "p '>>=' e" := (~~(point_strictly_under_edge p e))( at level 70, no associativity).
+Notation "p '>>>' e" := (~~(point_under_edge p e))(at level 70, no associativity).
+Notation "p '===' e" := (point_on_edge p e)( at level 70, no associativity).
+Notation "e1 '<|' e2" := (edge_below e1 e2)( at level 70, no associativity).
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
new file mode 100644
index 0000000..4213052
--- /dev/null
+++ b/theories/safe_cells.v
@@ -0,0 +1,735 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Export Field.
+Require Import generic_trajectories.
+Require Import math_comp_complements points_and_edges events cells.
+Require Import opening_cells cells_alg.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Require Import NArithRing.
+Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
+
+Open Scope ring_scope.
+
+Section safety_property.
+
+Variable R : realFieldType.
+
+Notation pt := (@pt R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+Notation Bpt := (Bpt R).
+Notation edge := (@edge R).
+Notation cell := (@cell R edge).
+Notation low := (low R edge).
+Notation high := (high R edge).
+Notation left_pts := (left_pts R edge).
+Notation right_pts := (right_pts R edge).
+Notation dummy_pt := (dummy_pt R 1).
+Notation event := (@event R edge).
+Notation point := (@point R edge).
+Notation outgoing := (@point R edge).
+
+Variables closed : seq cell.
+(* The last open cell.  We need to prove that that its top edge is top.
+   Then, coverage will be given for all obstacles by the fact that all
+   edges in obstacles are different from top. *)
+Variables bottom top : edge.
+Variable obstacles : seq edge.
+Variables points : seq pt.
+
+Hypothesis obstacles_sub :
+  {subset [seq low c | c <- closed] ++
+     [seq high c | c <- closed] <= bottom :: top :: obstacles}.
+
+Hypothesis obstacles_point_in :
+  {subset [seq left_pt g | g <- obstacles] ++
+    [seq right_pt g | g <- obstacles] <= points}.
+
+Hypothesis disj_closed :  {in closed &, disjoint_closed_cells R}.
+(*
+Hypothesis disj_open :  {in [:: o_cell] & closed, disjoint_open_closed_cells R}*)
+
+Hypothesis coverage : {in obstacles, forall g, edge_covered g [::] closed}.
+Hypothesis covered_points :
+   {in points, forall (p : pt), exists2 c,
+       c \in closed & p \in (right_pts c : seq pt) /\
+       (p >>> low c)}.
+
+Hypothesis non_empty_closed : {in closed, forall c, left_limit c < right_limit c}.
+Hypothesis closed_ok : {in closed, forall c, closed_cell_side_limit_ok c}.
+Hypothesis noc : {in bottom :: top :: obstacles &,
+  forall g1 g2, inter_at_ext g1 g2}.
+Hypothesis low_high : {in closed, forall c, low c <| high c}.
+Hypothesis low_dif_high : {in closed, forall c, low c != high c}.
+
+Lemma x_left_pts_left_limit (c : cell) (p : pt) :
+  closed_cell_side_limit_ok c ->
+  p \in (left_pts c : seq pt) -> p_x p = left_limit c.
+Proof.
+move=> + pin; move=> /andP[] ln0 /andP[] lsx _.
+by rewrite (eqP (allP lsx _ _)).
+Qed.
+
+Lemma x_right_pts_right_limit (c : cell) (p : pt) :
+  closed_cell_side_limit_ok c ->
+  p \in (right_pts c : seq pt) -> p_x p = right_limit c.
+Proof.
+move=> + pin; move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+move=> /andP[] rn0 /andP[] rsx _.
+by rewrite (eqP (allP rsx _ _)).
+Qed.
+
+Lemma left_limit_left_pt_high_cl (c : cell) :
+  closed_cell_side_limit_ok c ->
+  p_x (left_pt (high c)) <= left_limit c.
+Proof.
+move=> /andP[] ln0 /andP[] lsx /andP[] _ /andP[] /andP[] _ /andP[] + _ _.
+by rewrite (eqP (allP lsx _ (head_in_not_nil _ ln0))).
+Qed.
+
+Lemma right_limit_right_pt_high_cl (c : cell) :
+  closed_cell_side_limit_ok c ->
+  right_limit c <= p_x (right_pt (high c)).
+Proof.
+move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] _ /andP[] _ /andP[] _. 
+by rewrite (eqP (allP rsx _ (last_in_not_nil _ rn0))).
+Qed.
+
+Lemma left_limit_left_pt_low_cl (c : cell) :
+  closed_cell_side_limit_ok c ->
+  p_x (left_pt (low c)) <= left_limit c.
+Proof.
+move=> /andP[] ln0 /andP[] lsx /andP[] _ /andP[] _ /andP[].
+move=> /andP[] _ /andP[] + _ _.
+by rewrite (eqP (allP lsx _ (last_in_not_nil _ ln0))).
+Qed.
+
+Lemma right_limit_right_pt_low_cl (c : cell) :
+  closed_cell_side_limit_ok c ->
+  right_limit c <= p_x (right_pt (low c)).
+Proof.
+move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
+move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] /andP[] _ /andP[] _ + _.
+by rewrite (eqP (allP rsx _ (head_in_not_nil _ rn0))).
+Qed.
+
+Lemma right_valid :
+  {in closed, forall c, {in (right_pts c : seq pt), forall p, 
+      valid_edge (low c) p /\ valid_edge (high c) p}}.
+Proof.
+move=> c cin p pin.
+have cok := closed_ok cin.
+have lltr : left_limit c < right_limit c.
+  by apply: non_empty_closed cin.
+split.
+  apply/andP; split; rewrite (x_right_pts_right_limit cok pin).
+    apply/(le_trans (left_limit_left_pt_low_cl cok)).
+    by apply/ltW.
+  by apply: right_limit_right_pt_low_cl.
+apply/andP; split; rewrite (x_right_pts_right_limit cok pin).
+  apply/(le_trans (left_limit_left_pt_high_cl cok)).
+  by apply/ltW.
+by apply: right_limit_right_pt_high_cl.
+Qed.
+
+Lemma closed_cell_in_high_above_low p (c : cell) :
+  low c != high c ->
+  low c <| high c ->
+  inter_at_ext (low c) (high c) ->
+  closed_cell_side_limit_ok c ->
+  left_limit c < p_x p < right_limit c ->
+  p === high c -> p >>> low c.
+Proof.
+move=> dif bel noclh cok /andP[] midl midr on.
+have [vlp vhp] : valid_edge (low c) p /\ valid_edge (high c) p.
+  move: cok=> /andP[] ln0 /andP[] lsx /andP[].
+  move=> _ /andP[] /andP[] _ /andP[] lh _ /andP[] /andP[] _ /andP[] ll _.
+  move=> /andP[] rn0 /andP[] rsx /andP[].
+  move=> _ /andP[] /andP[] _ /andP[] _ rl /andP[] _ /andP[] _ rh.
+  rewrite (eqP (allP lsx _ (@last_in_not_nil [eqType of pt] dummy_pt _ ln0))) in ll.
+  rewrite (eqP (allP rsx _ (@head_in_not_nil [eqType of pt] dummy_pt _ rn0))) in rl.
+  rewrite (eqP (allP lsx _ (@head_in_not_nil [eqType of pt] dummy_pt _ ln0))) in lh.
+  rewrite (eqP (allP rsx _ (@last_in_not_nil [eqType of pt] dummy_pt _ rn0))) in rh.
+  split; rewrite /valid_edge/generic_trajectories.valid_edge.
+    by rewrite (ltW (le_lt_trans ll midl)) (ltW (lt_le_trans midr rl)).
+  by rewrite (ltW (le_lt_trans lh midl)) (ltW (lt_le_trans midr rh)).
+rewrite under_onVstrict // negb_or.
+move: noclh=> [abs | noclh]; first by rewrite abs eqxx in dif.
+apply/andP; split; last first.
+  apply/negP=> abs.
+  have := order_edges_strict_viz_point' vlp vhp bel abs.
+  by rewrite strict_nonAunder // on.
+apply/negP=> abs.
+have := noclh _ abs on; rewrite !inE=> /orP[] /eqP {}abs.
+  move: midl; apply/negP; rewrite -leNgt abs.
+  by apply: left_limit_left_pt_low_cl.
+(* TODO: at this place, the typechecking loops, this warrants a bug report. *)
+(*(  have := left_limit_max cok. *)
+move: midr; apply/negP; rewrite -leNgt abs.
+by apply: right_limit_right_pt_low_cl.
+Qed.
+
+(* I don't know yet if this is going to be used. *)
+Lemma above_low : 
+  {in closed, forall c p, p === high c -> valid_edge (low c) p ->
+     p >>= low c}.
+Proof.
+move=> c cin p /[dup] ponh /andP[] _ vh vl.
+apply/negP=> pul.
+have lbh : low c <| high c by apply: low_high.
+have := order_edges_strict_viz_point' vl vh lbh pul.
+by rewrite strict_nonAunder // ponh.
+Qed.
+
+Lemma right_side_under_high (c : cell) (p : pt) :
+  closed_cell_side_limit_ok c ->
+  valid_edge (high c) p ->
+  p \in (right_pts c : seq pt) ->
+  p <<= high c.
+Proof.
+move=> cok vph pin.
+set p' := Bpt (p_x p) (pvert_y p (high c)).
+have sx: p_x p = p_x p' by rewrite /p'.
+have p'on : p' === high c by apply: pvert_on vph.
+rewrite (under_edge_lower_y sx) //.
+have := cok.
+do 5 move=> /andP[] _.
+move=> /andP[] rn0 /andP[] rsx /andP[] srt /andP[] _ lon.
+have p'q : p' = last dummy_pt (right_pts c).
+  have := on_edge_same_point p'on lon.
+  rewrite (allP rsx _ pin)=> /(_ isT)=> samey.
+  by apply/(@eqP [eqType of pt]); rewrite pt_eqE samey (allP rsx _ pin).
+move: rn0 p'q pin srt.
+elim/last_ind: (right_pts c) => [| rpts p2 Ih] // _ p'q pin srt.
+move: pin; rewrite mem_rcons inE => /orP[/eqP -> | pin].
+  by rewrite p'q last_rcons.
+apply: ltW; rewrite p'q last_rcons.
+move: srt; rewrite map_rcons=> srt.
+by have := (allP (sorted_rconsE lt_trans srt)); apply; rewrite map_f.
+Qed.
+
+Lemma in_bound_closed_valid (c : cell) p :
+  closed_cell_side_limit_ok c ->
+  left_limit c <= p_x p -> p_x p <= right_limit c ->
+  valid_edge (low c) p /\ valid_edge (high c) p.
+Proof.
+move=> cok lp pr.
+have llh := left_limit_left_pt_high_cl cok.
+have lll := left_limit_left_pt_low_cl cok.
+have rrh := right_limit_right_pt_high_cl cok.
+have rrl := right_limit_right_pt_low_cl cok.
+split; rewrite /valid_edge/generic_trajectories.valid_edge.
+  by rewrite (le_trans lll lp) (le_trans pr rrl).
+by rewrite (le_trans llh lp) (le_trans pr rrh).
+Qed.
+
+Lemma left_side_under_high (c : cell) p :
+  closed_cell_side_limit_ok c ->
+  valid_edge (high c) p ->
+  p \in (left_pts c : seq pt) ->
+  p <<= high c.
+Proof.
+move=> cok vph pin.
+set p' := Bpt (p_x p) (pvert_y p (high c)).
+have sx: p_x p = p_x p' by rewrite /p'.
+have p'on : p' === high c by apply: pvert_on vph.
+rewrite (under_edge_lower_y sx) //.
+have := cok.
+move=> /andP[] ln0 /andP[] lsx /andP[] srt /andP[] hon _.
+have p'q : p' = head dummy_pt (left_pts c).
+  have := on_edge_same_point p'on hon.
+  rewrite (eqP (allP lsx _ pin)).
+  rewrite (x_left_pts_left_limit cok (head_in_not_nil _ ln0)) eqxx.
+  move=> /(_ isT)=> samey.
+  apply/(@eqP [eqType of pt]); rewrite pt_eqE samey andbT.
+  rewrite (eqP (allP lsx _ pin)) eq_sym.
+  by rewrite (allP lsx _ (head_in_not_nil _ ln0)).
+move: ln0 p'q pin srt.
+case: (left_pts c)=> [| p2 lpts] // _ p'q pin srt.
+move: pin; rewrite (@in_cons [eqType of pt]) => /orP[/eqP -> | pin].
+  by rewrite p'q.
+apply: ltW; rewrite p'q.
+move: srt=> /=; rewrite (path_sortedE); last first.
+  by move=> x y z xy yz; apply: (lt_trans yz xy).
+move=> /andP[] /allP/(_ (p_y p)) + _; apply.
+by rewrite (@map_f [eqType of pt]).
+Qed.
+
+Lemma safe_cell_interior c p :
+  c \in closed -> p <<< high c -> p >>> low c ->
+  left_limit c < p_x p < right_limit c ->
+  {in obstacles, forall g, ~~ (p === g)}.
+Proof.
+move=> ccl puh pal /andP[] pright pleft g gin; apply/negP=> pong.
+have pinc : inside_closed' p c.
+  by rewrite inside_closed'E (underW puh) pal pright (ltW pleft).
+have [[opc [pccs [pccssub [highs [cpccs [opco lopcq]]]]]] | ] := coverage gin.
+  by [].
+move=> [[ | pc1 pcc] [pccn0 [pcccl [ highs [conn [lpcc rpcc]]]]]].
+  by [].
+have : left_limit pc1 <= p_x p.
+  by move:(pong)=> /andP[] _ /andP[]; rewrite lpcc.
+rewrite le_eqVlt=> /orP[ /eqP pxq | ].
+  have plg : p = left_pt g.
+    move: lpcc; rewrite /= pxq=> /eqP samex.
+    have := on_edge_same_point pong (left_on_edge _).
+    rewrite samex=> /(_ isT) samey.
+    by apply/(@eqP [eqType of pt]); rewrite pt_eqE samex samey.
+  have pin : p \in points.
+    apply: obstacles_point_in; rewrite mem_cat; apply/orP; left.
+    by rewrite plg map_f.
+  have [c' ccl' [pc'r p'al]] := (covered_points pin).
+  have := disj_closed ccl ccl'.
+  move=> [cqc' | ].
+    have := non_empty_closed ccl'.
+    move: pleft; rewrite cqc'.
+    by rewrite (x_right_pts_right_limit (closed_ok ccl')) // lt_irreflexive.
+  move=> /(_ p); rewrite pinc=> /negP; apply.
+  rewrite inside_closed'E p'al.
+  have c'ok := closed_ok ccl'.
+  have /andP[_ /andP[_ /andP[_ /andP[_ /andP[_ ]]] ]] := c'ok.
+  move=> /andP[rn0 /andP[samex /andP[srt /andP[onlow onhigh]]]].
+  have prlq : p_x p = right_limit c' by apply/eqP/(allP samex).
+  rewrite (under_edge_lower_y prlq onhigh).
+  have -> /= : p_y p <= p_y (last dummy_pt (right_pts c')).
+    elim/last_ind:{-1} (right_pts c') (erefl (right_pts c'))=>[| ps pn _] psq.
+      by rewrite psq in rn0.
+    move: pc'r; rewrite psq mem_rcons inE => /orP[/eqP -> | pps].
+      by rewrite last_rcons.
+    move: (srt); rewrite psq map_rcons => srt'.
+    have := sorted_rconsE lt_trans srt'=> /allP/(_ _ (map_f _ pps))/ltW.
+    by rewrite last_rcons.
+  by rewrite prlq le_refl andbT (non_empty_closed ccl').
+elim: pcc pc1 pcccl highs conn rpcc {lpcc pccn0} =>
+  [ | pc2 pcc Ih] pc1 pcccl highs conn rpcc pc1lp.
+  have pc1cl : pc1 \in closed by apply: pcccl; rewrite inE eqxx.  
+  have hpc1 : high pc1 = g by apply: (highs _ (mem_head _ _)).
+  move: rpcc; rewrite /last_cell/= => rpc1.
+  have vgp : valid_edge g p by move: pong=> /andP[].
+  have [pr | pnr ] := eqVneq (p : pt) (right_pt g).
+    have [c' c'in [prc' pin']] : exists2 c', c' \in closed &
+        p_x p = right_limit c' /\ inside_closed' p c'.
+      have pp : p \in points.
+        by apply/obstacles_point_in; rewrite pr mem_cat map_f // orbT.
+      have [c' c'in [pr' pal']] := covered_points pp.
+      exists c'; rewrite // inside_closed'E pal'.
+      rewrite (x_right_pts_right_limit (closed_ok c'in)) // le_refl.
+      rewrite (non_empty_closed c'in).
+      have [vpl' vph'] := right_valid c'in pr'.
+      by rewrite (right_side_under_high (closed_ok c'in)).
+    have [cqc' | ] := disj_closed ccl c'in.
+      by move: pleft; rewrite prc' cqc'; rewrite lt_irreflexive.
+    by move=> /(_ p); rewrite pin' pinc.
+  have noc1 : inter_at_ext (low pc1) (high pc1).
+    by apply/noc; apply: obstacles_sub; rewrite mem_cat map_f //= ?orbT.
+  have ponh : p === high pc1 by rewrite hpc1.
+  have pin1 : inside_closed' p pc1.
+    rewrite inside_closed'E under_onVstrict hpc1 // pong pc1lp /=.
+    rewrite rpc1; move: vgp=> /andP[] _ ->; rewrite andbT.
+    have := closed_cell_in_high_above_low (low_dif_high pc1cl) (low_high pc1cl)
+    noc1 (closed_ok pc1cl) _ ponh; apply.
+    rewrite pc1lp /= rpc1.
+    move: (pong)=> /andP[] _ /andP[] _; rewrite le_eqVlt=> /orP[]; last by [].
+    move=> abs.
+    move: pnr=> /negP[]; rewrite pt_eqE abs /=.
+    by have := on_edge_same_point pong (right_on_edge _) abs.
+  have vph1 : valid_edge (high pc1) p by move: ponh=> /andP[].
+  have [cqc' | ] := disj_closed ccl pc1cl.
+    by move: puh; rewrite strict_nonAunder cqc' // ponh.
+  by move=> /(_ p); rewrite pin1 pinc.
+have pcccl' : {subset pc2 :: pcc <= closed}.
+  by move=> c' c'in; apply: pcccl; rewrite inE c'in orbT.
+have highs' : {in pc2 :: pcc, forall c, high c = g}.
+  by move=> c' c'in; apply highs; rewrite inE c'in orbT.
+have conn' : connect_limits (pc2 :: pcc).
+  by move: conn; rewrite /= => /andP[].
+have rpcc' : right_limit (last_cell (pc2 :: pcc)) = p_x (right_pt g).
+  by exact: rpcc.
+have [pleft2 | pright2 ] := lerP (p_x p) (left_limit pc2).
+(* In this case, p is inside pc1, contradiction with pinc *)
+  have v1 : valid_edge g p by move: pong=> /andP[].
+  have pc1cl : pc1 \in closed by apply: pcccl; rewrite inE eqxx.  
+  suff pin1 : inside_closed' p pc1.
+    have [cqpc1 | ] := disj_closed ccl pc1cl.
+      move: puh; rewrite cqpc1 (highs _ (mem_head _ _)) strict_nonAunder //.
+      by rewrite pong.
+  by move=> /(_ p); rewrite pin1 pinc.
+  rewrite inside_closed'E.
+  have r1l2 : right_limit pc1 = left_limit pc2.
+    by apply/eqP; move: conn=> /= /andP[].
+  move: (conn)=> /= /andP[] /eqP -> _; rewrite pleft2 pc1lp !andbT.
+  rewrite (highs _ (mem_head _ _)) under_onVstrict // pong /=.
+  have ponh : p === high pc1 by rewrite (highs _ (mem_head _ _)).
+  have noc1 : inter_at_ext (low pc1) (high pc1).
+    by apply/noc; apply: obstacles_sub; rewrite mem_cat map_f //= ?orbT.
+  move: (pleft2); rewrite le_eqVlt=> /orP[/eqP pat | pltstrict]; last first.
+    have := closed_cell_in_high_above_low (low_dif_high pc1cl) (low_high pc1cl)
+      noc1 (closed_ok pc1cl) _ ponh; apply.
+    move: (conn)=> /= /andP[] /eqP -> _.
+    by rewrite pltstrict pc1lp.
+  have sl : p_x (left_pt g) < p_x p.
+    have llh := left_limit_left_pt_high_cl (closed_ok pc1cl).
+    by rewrite -(highs _ (mem_head _ _)); apply: (le_lt_trans llh).
+  have pc2cl : pc2 \in closed by apply: pcccl'; rewrite mem_head.
+  have sr : p_x p < p_x (right_pt g).
+    rewrite pat.
+    rewrite (lt_le_trans (non_empty_closed pc2cl)) //.
+    have := right_limit_right_pt_high_cl (closed_ok pc2cl).
+    by rewrite (highs' _ (mem_head _ _)).
+  have [vl1 vh1] : valid_edge (low pc1) p /\ valid_edge (high pc1) p.
+    have := in_bound_closed_valid (closed_ok pc1cl) (ltW pc1lp).
+    by rewrite pat r1l2 le_refl=> /(_ isT).
+  have := above_low pc1cl ponh vl1.
+  rewrite strict_nonAunder // negb_and negbK=> /orP[] ponl; last by [].
+  have lo : low pc1 \in bottom :: top :: obstacles.
+    by apply: obstacles_sub; rewrite mem_cat map_f.
+  have ho : high pc1 \in bottom :: top :: obstacles.
+    by apply: obstacles_sub; rewrite mem_cat map_f ?orbT.
+  have [lqh | ] := noc ho lo.
+    by have := low_dif_high pc1cl; rewrite lqh eqxx.
+  move=> /(_ p ponh ponl); rewrite !inE=> /orP[]/eqP pext.
+    by move: sl; rewrite pext (highs _ (mem_head _ _)) lt_irreflexive.
+  by move: sr; rewrite pext (highs _ (mem_head _ _)) lt_irreflexive.
+(* In this case, we use the induction hypothesis *)
+by have := Ih pc2 pcccl' highs' conn' rpcc' pright2.
+Qed.
+
+End safety_property.
+
+Lemma last_no_dup_seq {T : eqType} (s : seq T) d:
+  last d (no_dup_seq s) = last d s.
+Proof.
+elim: s d => [ | a [ | b s'] Ih] //.
+rewrite /=; case: ifP=> [/eqP ab | anb].
+  by apply: Ih.
+move=> d /=; apply: Ih.
+Qed.
+
+Lemma head_no_dup_seq {T : eqType} (s : seq T) d:
+  head d (no_dup_seq s) = head d s.
+Proof.
+elim: s d => [ | a [ | b s'] Ih] //.
+rewrite /=; case: ifP=> [/eqP ab | anb].
+  by move=> d; rewrite Ih ab.
+by [].
+Qed.
+
+Section main_statement.
+
+Variable R : realFieldType.
+
+Notation pt := (@pt R).
+Notation p_x := (p_x R).
+Notation p_y := (p_y R).
+Notation Bpt := (Bpt R).
+Notation edge := (@edge R).
+Notation cell := (@cell R edge).
+Notation low := (low R edge).
+Notation high := (high R edge).
+Notation left_pts := (left_pts R edge).
+Notation right_pts := (right_pts R edge).
+Notation dummy_pt := (dummy_pt R 1).
+Notation event := (@event R edge).
+Notation point := (@point R edge).
+Notation outgoing := (@outgoing R edge).
+
+Definition leftmost_points :=
+ leftmost_points R eq_op le +%R (fun x y => x - y) *%R 
+  (fun x y => x / y) edge (@left_pt R) (@right_pt R).
+
+Arguments pt_eqb : simpl never.
+
+Lemma start_open_cell_ok (bottom top : edge) p :
+  {in [:: bottom; top] &, forall g1 g2, inter_at_ext g1 g2} ->
+  inside_box bottom top p ->
+  open_cell_side_limit_ok (start_open_cell bottom top).
+Proof.
+move=> noc0 /andP[] /andP[] pab put /andP[] /andP[] lbp prb /andP[] ltp prt.
+have noc : below_alt bottom top.
+  by apply: (inter_at_ext_no_crossing noc0); rewrite !inE eqxx ?orbT.
+have vb : valid_edge bottom p by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.
+have vt : valid_edge top p by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.
+rewrite /open_cell_side_limit_ok /=.
+have ln0 : leftmost_points bottom top != [::] :> seq pt.
+  rewrite /leftmost_points/generic_trajectories.leftmost_points.
+  case: ifP=> [lbl | ltl]; rewrite -/(vertical_intersection_point _ _) pvertE //.
+      rewrite R_ltb_lt in lbl.
+      rewrite /valid_edge/generic_trajectories.valid_edge. 
+      by rewrite ltW // ?ltW // (lt_trans ltp).
+    by rewrite /no_dup_seq /=; case: ifP=> _.
+  move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
+  by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).    
+rewrite ln0 /=.
+have samex : all (fun p => p_x p == left_limit (start_open_cell bottom top))
+               (leftmost_points bottom top).
+  rewrite /left_limit/generic_trajectories.left_limit.
+  rewrite /left_pts/generic_trajectories.left_pts /=.
+  rewrite /leftmost_points/generic_trajectories.leftmost_points.
+  case: ifP=> [lbl | ltl].
+    rewrite R_ltb_lt in lbl.
+    rewrite -/(vertical_intersection_point _ _).
+    rewrite pvertE; last first.
+      by rewrite /valid_edge/generic_trajectories.valid_edge ltW // ltW // (lt_trans ltp).
+    by rewrite /= !eqxx.
+  move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
+  rewrite -/(vertical_intersection_point _ _).
+  rewrite pvertE; last first.
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).    
+  set W := (X in no_dup_seq_aux _ X).
+  have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
+    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
+  have := (@eq_all_r [eqType of pt] _ _ (@mem_no_dup_seq [eqType of pt] _)).
+  move=> ->.
+  rewrite (@last_no_dup_seq [eqType of pt]).
+  by rewrite /W /= !eqxx.
+rewrite samex /=.
+have headin : head dummy_pt (leftmost_points bottom top) === top.
+  rewrite /leftmost_points/generic_trajectories.leftmost_points.
+  case: ifP => [lbl | ltl].
+    rewrite R_ltb_lt in lbl.
+    rewrite -/(vertical_intersection_point _ _).
+    rewrite pvertE; last first.
+      by rewrite /valid_edge/generic_trajectories.valid_edge ltW // ltW // (lt_trans ltp).
+    by rewrite /= left_on_edge.
+  move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
+  rewrite -/(vertical_intersection_point _ _).
+  rewrite pvertE; last first.
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp). 
+  set W := (X in no_dup_seq_aux _ X).
+  have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
+    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
+  rewrite (@head_no_dup_seq [eqType of pt]).
+  rewrite /= pvert_on // /valid_edge/generic_trajectories.valid_edge.
+  by rewrite ltl ltW // (lt_trans lbp).
+have lastin : last dummy_pt (leftmost_points bottom top) === bottom.
+  rewrite /leftmost_points/generic_trajectories.leftmost_points.
+  case: ifP => [lbl | ltl].
+    rewrite R_ltb_lt in lbl.
+    rewrite -/(vertical_intersection_point _ _).
+    rewrite pvertE; last first.
+      by rewrite /valid_edge/generic_trajectories.valid_edge ltW // ltW // (lt_trans ltp).
+    by rewrite /= pvert_on // /valid_edge/generic_trajectories.valid_edge ltW // ltW // (lt_trans ltp).
+  move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
+  rewrite -/(vertical_intersection_point _ _).
+  rewrite pvertE; last first.
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp). 
+  set W := (X in no_dup_seq_aux _ X).
+  have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
+    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
+  rewrite (@last_no_dup_seq [eqType of pt]).
+  by rewrite /= left_on_edge.
+rewrite headin lastin !andbT.
+have blt : bottom <| top.
+  by have := edge_below_from_point_above noc vb vt (underWC pab) put.
+rewrite /leftmost_points/generic_trajectories.leftmost_points.
+case: ifP => [lbl | ltl].
+  rewrite R_ltb_lt in lbl.
+  have vtb : valid_edge bottom (left_pt top).
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltW // ltW // (lt_trans ltp).
+  rewrite -/(vertical_intersection_point _ _).
+  rewrite pvertE //= andbT.
+  have := order_below_viz_vertical vtb (valid_edge_left top).
+  rewrite pvertE // => /(_ _ (left_pt top) erefl _ blt) /=.
+  have -> : vertical_intersection_point (left_pt top) top = Some (left_pt top).
+   rewrite (pvertE (valid_edge_left _)); congr (Some _); apply/eqP.
+   by rewrite pt_eqE /= (on_pvert (left_on_edge _)) !eqxx.
+  move=> /(_ erefl); rewrite le_eqVlt=> /orP[/eqP abs | -> //].
+  have := pvert_on vtb; rewrite abs => lton.
+  have lteq : Bpt (p_x (left_pt top))(p_y (left_pt top)) =
+        left_pt top.
+    by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+  rewrite lteq in lton.
+  have [bqt |]: inter_at_ext bottom top by apply: noc0; rewrite !inE eqxx ?orbT.
+    by rewrite bqt lt_irreflexive in lbl.       
+  move=> /(_ _ lton (left_on_edge _)); rewrite !inE=> /orP[] /eqP same.
+    by rewrite same lt_irreflexive in lbl.
+  by have := lt_trans ltp prb; rewrite same lt_irreflexive.
+move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
+have vbt : valid_edge top (left_pt bottom).
+  by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp prt).
+rewrite -/(vertical_intersection_point _ _).
+rewrite pvertE //=.
+case: ifP=> [bont | bnont ].
+  by [].
+have := order_below_viz_vertical (valid_edge_left bottom) vbt.
+have -> : vertical_intersection_point (left_pt bottom) bottom =
+               Some (left_pt bottom).
+  rewrite (pvertE (valid_edge_left _)); congr (Some _); apply/eqP.
+  by rewrite pt_eqE /= (on_pvert (left_on_edge _)) !eqxx.
+rewrite pvertE // => /(_ (left_pt bottom) _ erefl erefl blt) /=.
+rewrite le_eqVlt=> /orP[/eqP abs | -> //].
+have := pvert_on vbt; rewrite abs => lton.
+have lteq : Bpt (p_x (left_pt bottom))(p_y (left_pt bottom)) =
+        left_pt bottom.
+  by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+rewrite -abs lteq in lton.
+have [bqt |]: inter_at_ext top bottom by apply: noc0; rewrite !inE eqxx ?orbT.
+  by move: pab; rewrite -bqt under_onVstrict // put orbT.
+  move=> /(_ _ lton (left_on_edge _)); rewrite !inE=> /orP[] /eqP same.
+  move: bnont.
+  rewrite same (on_pvert (left_on_edge top)).
+  rewrite -[X in X = false]/(_ == _ :> pt).
+  by rewrite pt_eqE !eqxx.
+by have := lt_trans lbp prt; rewrite same lt_irreflexive.
+Qed.
+
+Lemma has_inside_box_bottom_below_top (bottom top : edge) p :
+  {in [:: bottom; top] &, forall g1 g2, inter_at_ext g1 g2} ->
+  inside_box bottom top p ->
+  bottom <| top.
+Proof.
+move=> noc0.
+have : below_alt bottom top.
+  by apply: (inter_at_ext_no_crossing noc0); rewrite !inE eqxx ?orbT.
+move=> [] // abs.
+move=> /andP[] /andP[] pab put /andP[] /andP[] vb1 vb2 /andP[] vt1 vt2.
+have vb : valid_edge bottom p.
+  by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.
+have vt : valid_edge top p.
+  by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.  
+have pub := order_edges_strict_viz_point' vt vb abs put.
+by move: pab; rewrite under_onVstrict // pub orbT.
+Qed.
+
+Lemma edges_inside_from_events_inside (bottom top : edge) evs:
+    all (inside_box bottom top) ([seq point e | e <- evs] : seq pt) ->
+    {in evs, forall ev, out_left_event ev} ->
+    close_edges_from_events evs ->
+   {in events_to_edges evs,
+         forall g : edge,
+         inside_box bottom top (left_pt g) &&
+         inside_box bottom top (right_pt g)}.
+Proof.
+elim: evs => [ | e evs Ih] /=; first by [].
+move=> /andP[] inbox_e inbox_es out_es0.
+have out_e : out_left_event e by apply: out_es0; rewrite mem_head.
+have out_es : {in evs, forall e, out_left_event e}.
+   by move=> e' e'in; apply: out_es0; rewrite inE e'in orbT.
+move=> /andP[] close_e close_es.
+move=> g; rewrite events_to_edges_cons mem_cat=> /orP[] gin; last first.
+  by apply: (Ih   inbox_es out_es close_es).
+apply/andP; split; first by rewrite (eqP (out_e g gin)).
+move: close_e=> /allP /(_ g gin).
+move/hasP=> [e2 e2in /eqP ->].
+by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite map_f.
+Qed.
+
+Lemma start_yields_safe_cells evs bottom top (open closed : seq cell):
+  sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) evs ->
+  {in [:: bottom, top & 
+         events_to_edges evs] &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- evs] ->
+  {in evs, forall ev : event, out_left_event ev} ->
+  close_edges_from_events evs ->
+  {in events_to_edges evs & evs, forall g e, non_inner g (point e)} ->
+  {in evs, forall e, uniq (outgoing e)} ->
+  main_process bottom top evs = (open, closed) ->
+  {in closed & events_to_edges evs, forall c g p,
+    strict_inside_closed p c -> ~~(p === g)}.
+Proof.
+have [ev0 | evsn0] := eqVneq evs [::].
+  rewrite /start /=; rewrite ev0 /=.
+  by move=> _ _ _ _ _ _ _ [] _ <-.
+move=> general_position no_crossing.
+move=> all_points_in out_edges_correct.
+move=> edges_closed no_event_in_edge outgoing_event_unique start_eq.
+have [e0 e0in] : exists e, e \in evs.
+  by case: (evs) evsn0 => [ | a ?] //; exists a; rewrite mem_head.
+have inbox_e : inside_box bottom top (point e0).
+  by apply: (@allP [eqType of pt] _ _ all_points_in); rewrite map_f.
+have noc0 : {in [:: bottom; top] &, forall g1 g2, inter_at_ext g1 g2}.
+  move=> g1 g2 g1in g2in.
+  by apply: no_crossing; rewrite -[_ :: _]/([:: _; _] ++ _) mem_cat ?g1in ?g2in.
+have startok : open_cell_side_limit_ok (start_open_cell bottom top).
+   by have := start_open_cell_ok noc0 inbox_e.
+have bottom_below_top : bottom <| top.
+  by have := has_inside_box_bottom_below_top noc0 inbox_e.
+have sorted_lex : sorted (@lexPtEv _) evs.
+  move: general_position; apply: sub_sorted.
+  by move=> e1 e2; rewrite /lexPtEv/lexPt=> ->.
+have all_edges_in :   {in events_to_edges evs, forall g,
+         inside_box bottom top (left_pt g) &&
+         inside_box bottom top (right_pt g)}.
+  by apply: edges_inside_from_events_inside.
+have [closed_has_disjoint_cells no_intersection_closed_open]:=
+   complete_disjoint_general_position general_position bottom_below_top
+   startok no_crossing all_edges_in all_points_in sorted_lex (@subset_id _ _)
+   out_edges_correct edges_closed start_eq.
+have [all_edges_covered all_points_covered]:=
+   start_edge_covered_general_position general_position bottom_below_top
+   startok no_crossing all_edges_in all_points_in sorted_lex (@subset_id _ _)
+   out_edges_correct edges_closed no_event_in_edge outgoing_event_unique
+   start_eq.
+have [closed_main_properties [subcl [all_closed_ok last_open_props]]] :=
+   start_safe_sides general_position bottom_below_top startok no_crossing
+   all_edges_in all_points_in sorted_lex (@subset_id _ _) out_edges_correct
+   edges_closed no_event_in_edge outgoing_event_unique start_eq.
+move=> c g cin gin p pin.
+set ref_points := [seq point e | e <- evs].
+(* TODO : decide on moving this to a separate lemma. *)
+have sub_ref : {subset [seq left_pt g | g <- events_to_edges evs] ++
+                  [seq right_pt g | g <- events_to_edges evs] <=
+                  (ref_points : seq pt)}.
+  rewrite /ref_points.
+  move: edges_closed out_edges_correct.
+  elim: (evs) => [ | ev evs' Ih] //= => /andP [cl1 /Ih {}Ih].
+  move=> out_evs.
+  have oute : out_left_event ev by apply: out_evs; rewrite mem_head.
+  have {}out_evs : {in evs', forall ev, out_left_event ev}.
+   by move=> e ein; apply: out_evs; rewrite inE ein orbT.
+  have {}Ih := Ih out_evs.
+  rewrite events_to_edges_cons.
+  move=> q; rewrite mem_cat=> /orP[] /mapP[e + ->].
+    rewrite mem_cat => /orP[/oute/eqP -> | ein ]; first by rewrite mem_head.
+    rewrite inE; apply/orP; right; apply: Ih.
+    by rewrite mem_cat map_f.
+  rewrite mem_cat=> /orP[/(allP cl1)/hasP[e' e'in /eqP ->] | e'in].
+    by rewrite inE map_f ?orbT.
+  rewrite inE; apply/orP; right; apply: Ih.
+  by rewrite mem_cat map_f ?orbT.
+have covered_closed :
+  {in events_to_edges evs, forall g, edge_covered g [::] closed}.
+  move: last_open_props=> [slo [lloq [hloq [ocdis last_open_props]]]].
+  case oeq : open slo => [ | lsto [ | ? ?]] // _.
+  move=> g' g'in.
+  (* TODO : make a separate lemma. *)
+  have g'ntop : g' != top.
+    apply/negP=> /eqP abs.
+    have := all_edges_in _ g'in => /andP[] /andP[] _ /andP[] _.
+    by rewrite abs lt_irreflexive.
+  have := all_edges_covered _ g'in; rewrite oeq.
+  move=> [ | closed_covered]; last by right; exact: closed_covered.
+  move=> [opc [pcc [_ [highs [ _ [ opcin _]]]]]].
+  move: g'ntop.
+  rewrite -(highs opc); last by rewrite mem_rcons mem_head.
+  move: opcin; rewrite inE=> /eqP ->.
+  by rewrite -hloq oeq /= eqxx.
+have non_empty_closed :
+ {in closed, forall c, left_limit c < right_limit c}.
+ by move=> c' c'in; have [_ [_ []]]:= closed_main_properties _ c'in.
+have rf_cl : {in closed, forall c, low c <| high c}.
+  by move=> c' c'in; have [it _] := closed_main_properties _ c'in.
+have dif_lh_cl : {in closed, forall c, low c != high c}.
+  by move=> c' c'in; have [_ [it _]] := closed_main_properties _ c'in.
+have points_covered' : {in [seq left_pt g0 | g0 <- events_to_edges evs] ++
+       [seq right_pt g0 | g0 <- events_to_edges evs],
+     forall p0 : pt_eqType R,
+     exists2 c0 : cell_eqType R,
+       c0 \in closed & p0 \in (right_pts c0 : seq pt) /\ p0 >>> low c0}.
+  by move=> q /sub_ref/mapP[e ein ->]; apply: all_points_covered.
+have puh : p <<< high c.
+  by move: pin; rewrite /strict_inside_closed => /andP[] /andP[].
+have pal : p >>> low c.
+  by move: pin; rewrite /strict_inside_closed => /andP[] /andP[].
+have p_between : left_limit c < p_x p < right_limit c.
+  by move: pin; rewrite /strict_inside_closed=> /andP[].
+by have := safe_cell_interior subcl (@subset_id _ _) closed_has_disjoint_cells
+  covered_closed points_covered' non_empty_closed (allP all_closed_ok)
+  no_crossing rf_cl dif_lh_cl cin puh pal p_between gin.
+Qed.
+
+End main_statement.

From a90705ce8d54af3ca21566c4bea67d3bd58e8ec9 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Tue, 23 Apr 2024 11:47:38 +0900
Subject: [PATCH 09/43] compiles with mc2

---
 _CoqProject                 | 12 ++++++++++++
 theories/cells.v            |  3 ++-
 theories/cells_alg.v        |  7 +++----
 theories/door_crossing.v    | 16 ++++++++++------
 theories/events.v           |  3 ++-
 theories/opening_cells.v    |  2 +-
 theories/points_and_edges.v |  5 +++--
 theories/safe_cells.v       |  4 ++--
 8 files changed, 35 insertions(+), 17 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index 2e74d0f..c03140a 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -22,6 +22,18 @@ theories/encompass.v
 theories/counterclockwise.v
 theories/axiomsKnuth.v
 theories/preliminaries_hull.v
+theories/cells.v
+theories/cells_alg.v
+theories/door_crossing.v
+theories/events.v
+theories/extraction_command.v
+theories/generic_trajectories.v
+theories/math_comp_complements.v
+theories/no_crossing.v
+theories/opening_cells.v
+theories/points_and_edges.v
+theories/safe_cells.v
+theories/smooth_trajectories.v
 
 -R theories trajectories
 
diff --git a/theories/cells.v b/theories/cells.v
index 6707b6e..b901345 100644
--- a/theories/cells.v
+++ b/theories/cells.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect all_algebra.
 Require Export Field.
 Require Import math_comp_complements generic_trajectories points_and_edges
@@ -54,7 +55,7 @@ have [/eqP <-|/eqP anb] := boolP(lptsa == lptsb :> seq pt).
 by apply: ReflectF=> [][].
 Qed.
 
-Canonical cell_eqType := EqType cell (EqMixin cell_eqP).
+HB.instance Definition _ := hasDecEq.Build _ cell_eqP.
 
 Definition valid_cell c x := valid_edge (low c) x /\ valid_edge (high c) x.
 
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index 964b7f9..b869668 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -763,14 +763,13 @@ case:ifP (o1) (o2) =>[/eqP q1 |enp1];case:ifP=>[/eqP q2 |enp2];
   rewrite -?q1 -?q2 /= ?eqxx ?x2 ?x1 /= => -> -> //; rewrite /= ?andbT.
 - move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] _ eh.
   have := (under_edge_strict_lower_y x2 (negbT enp2) eh o2).
-  rewrite q1=> ->; rewrite andbT.
-  by rewrite /right_limit /= x2 eqxx.
+  by rewrite q1=> ->//; rewrite andbT.
 - move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el _.
   have := (above_edge_strict_higher_y x1 _ el).
-  by rewrite eq_sym (negbT enp1)=> /(_ isT); apply.
+  by apply => //; exact: negbT.
 move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el eh.
 rewrite (above_edge_strict_higher_y x1 _ el) //; last first.
-  by rewrite eq_sym enp1.
+  exact: negbT.
 rewrite  (under_edge_strict_lower_y x2 (negbT enp2) eh) //.
 by rewrite -x1 x2 eqxx.
 Qed.
diff --git a/theories/door_crossing.v b/theories/door_crossing.v
index 3605d6c..984dd99 100644
--- a/theories/door_crossing.v
+++ b/theories/door_crossing.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect all_algebra all_real_closed reals.
 From mathcomp.algebra_tactics Require Import ring lra.
 Require Import casteljau convex counterclockwise intersection.
@@ -14,7 +15,7 @@ Local Open Scope ring_scope.
 Section sandbox.
 
 Lemma poly_coord {R : rcfType} 
-  (c : pair_vectType (regular_vectType R) (regular_vectType R))
+  (c : (R^o * R^o)%type)
   (p : {poly R}) (t : R) :
   p.[t] *: c = c.1 * p.[t] *: (1, 0) + c.2 * p.[t] *: (0, 1).
 Proof.
@@ -161,7 +162,7 @@ Qed.
 
 Fail Check (fun (x : vert_edge) (l : seq vert_edge) => x \in l).
 
-Canonical vert_edge_eqType := EqType vert_edge (EqMixin vert_edge_eqP).
+HB.instance Definition _ := hasDecEq.Build _ vert_edge_eqP.
 
 Fixpoint seq_to_intervals_aux [A : Type] (a : A) (s : seq A) :=
 match s with
@@ -177,12 +178,12 @@ end.
 
 Definition cell_safe_exits_left (c : cell) : seq vert_edge :=
   let lx := (seq.head dummy_pt (left_pts c)).1 in
-  map (fun p => Build_vert_edge lx (fst p).2 (snd p).2) 
+  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2) 
    (seq_to_intervals (left_pts c)).
 
 Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   let lx := (seq.head dummy_pt (right_pts c)).1 in
-  map (fun p => Build_vert_edge lx (fst p).2 (snd p).2) 
+  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2) 
    (seq_to_intervals (rev (right_pts c))).
 
 Definition dummy_vert_edge :=
@@ -1030,7 +1031,7 @@ have tmp1 : t ^ 2 * c'.2 * (b.1 - a.1) =
   by rewrite /= mulrDl (mulrAC _ _ (b.1 - a.1)) mulfVK.
 rewrite !bezier_step_conv /=.
 have tmp x (y : R^o) : x *: y = x * y by [].
-rewrite !tmp tmp1.
+rewrite !tmp tmp1 /=.
 ring.
 Qed.
 
@@ -1076,7 +1077,8 @@ rewrite subr_eq=> /eqP ->; rewrite /p' /=.
 rewrite addrA (addrC _ (left_pt e).2) -!addrA.
 rewrite ler_add2.
 rewrite addrC -ler_subr_addl mulrAC addrN.
-rewrite pmulr_lle0 // invr_gt0; lra.
+rewrite pmulr_lle0 // invr_gt0/=.
+by rewrite subr_gt0.
 Qed.
 
 Lemma safe_bezier_ccw (a b c : Plane R) (v : vert_edge) (u : R) :
@@ -1128,3 +1130,5 @@ apply: conv_num_ltr=> //.
   by rewrite det_inverse oppr_lte0 -det_cyclique.
 by rewrite mkedgeE /= det_alternate.
 Qed.
+
+End sandbox.
diff --git a/theories/events.v b/theories/events.v
index 7bca54f..454b308 100644
--- a/theories/events.v
+++ b/theories/events.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect all_algebra.
 Require Export Field.
 Require Import math_comp_complements.
@@ -40,7 +41,7 @@ have [/eqP <- | /eqP anb] := boolP (pta == ptb :> pt).
 by apply: ReflectF=> [][].
 Qed.
 
-Canonical event_eqType := EqType event (EqMixin event_eqP).
+HB.instance Definition _ := hasDecEq.Build _ event_eqP.
 
 Notation Bevent := (Bevent _ _).
 (* As in insertion sort, the add_event function assumes that event are
diff --git a/theories/opening_cells.v b/theories/opening_cells.v
index a1921b1..2dfde42 100644
--- a/theories/opening_cells.v
+++ b/theories/opening_cells.v
@@ -614,7 +614,7 @@ have einfc' : ~~ (point e <<< c').
   apply : onAbove.
   have := outlefte c' cin => /eqP <-.
   apply :  left_on_edge.
-have outq: (forall e0 : edge_eqType R, e0 \in q -> left_pt e0 == point e).
+have outq: (forall e0 : edge, e0 \in q -> left_pt e0 == point e).
   move => e0 ein.
   apply outlefte.
   by rewrite inE ein orbT.
diff --git a/theories/points_and_edges.v b/theories/points_and_edges.v
index 2cb6951..a685524 100644
--- a/theories/points_and_edges.v
+++ b/theories/points_and_edges.v
@@ -1,3 +1,4 @@
+From HB Require Import structures.
 From mathcomp Require Import all_ssreflect all_algebra.
 Require Export Field.
 Require Import math_comp_complements.
@@ -32,7 +33,7 @@ have [/eqP <-|/eqP anb] := boolP(a_x == b_x).
 by apply: ReflectF=> [][].
 Qed.
 
-Canonical pt_eqType := EqType pt (EqMixin pt_eqP).
+HB.instance Definition _ := hasDecEq.Build _ pt_eqP.
 
 Lemma pt_eqE (p1 p2 : pt) :
    (p1 == p2) = (p_x p1 == p_x p2) && (p_y p1 == p_y p2).
@@ -61,7 +62,7 @@ have [/eqP a1a2 | /eqP a1na2] := boolP(a1 == a2).
 by apply: ReflectF=>[][].
 Qed.
 
-Canonical edge_eqType := EqType edge (EqMixin edge_eqP).
+HB.instance Definition _ := hasDecEq.Build _ edge_eqP.
 
 Definition area3 :=
   area3 R +%R (fun x y => x - y) *%R.
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index 4213052..3ac1b54 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -717,8 +717,8 @@ have dif_lh_cl : {in closed, forall c, low c != high c}.
   by move=> c' c'in; have [_ [it _]] := closed_main_properties _ c'in.
 have points_covered' : {in [seq left_pt g0 | g0 <- events_to_edges evs] ++
        [seq right_pt g0 | g0 <- events_to_edges evs],
-     forall p0 : pt_eqType R,
-     exists2 c0 : cell_eqType R,
+     forall p0 : pt,
+     exists2 c0 : cell,
        c0 \in closed & p0 \in (right_pts c0 : seq pt) /\ p0 >>> low c0}.
   by move=> q /sub_ref/mapP[e ein ->]; apply: all_points_covered.
 have puh : p <<< high c.

From a7af2627ebae6240d3f73cf9b493b62a04f8cb1b Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Tue, 23 Apr 2024 12:54:52 +0900
Subject: [PATCH 10/43] less warnings

---
 theories/bern.v             | 122 +++++++++++++++---------------
 theories/casteljau.v        |  54 ++++++-------
 theories/cells_alg.v        |  66 ++++++++--------
 theories/civt.v             |   2 +-
 theories/conv.v             |   6 +-
 theories/convex.v           |   2 +-
 theories/counterclockwise.v |   4 +-
 theories/desc.v             | 146 ++++++++++++++++++------------------
 theories/door_crossing.v    |  57 +++++++-------
 theories/isolate.v          |   8 +-
 theories/opening_cells.v    |  40 +++++-----
 theories/pol.v              |  82 ++++++++++----------
 theories/poly_normal.v      |   6 +-
 theories/preliminaries.v    |   9 +--
 14 files changed, 301 insertions(+), 303 deletions(-)

diff --git a/theories/bern.v b/theories/bern.v
index 4223c62..4e0d1bc 100644
--- a/theories/bern.v
+++ b/theories/bern.v
@@ -1,4 +1,4 @@
-From mathcomp Require Import all_ssreflect all_algebra.
+From mathcomp Require Import all_ssreflect all_algebra archimedean.
 (*Require Import QArith ZArith Zwf Omega.
 From mathcomp Require Import ssreflect eqtype ssrbool ssrnat div fintype seq ssrfun order.
 From mathcomp Require Import bigop fingroup choice binomial poly.
@@ -64,15 +64,15 @@ Lemma one_root2_translate {R : archiFieldType} (l : {poly R}) a b :
   one_root2 (translate_pol l a) b -> one_root2 l (a + b).
 Proof.
 move=> [x1 [k [x1a kp neg sl]]]; exists (a + x1), k; split => //.
-- by rewrite ltr_add2l.
+- by rewrite ltrD2l.
 - move=> x abx xax1; rewrite (_ : x = x - a + a); last by rewrite addrNK.
-  by rewrite -translate_polq; apply: neg; rewrite ?ltr_subr_addl ?ler_subl_addl.
+  by rewrite -translate_polq; apply: neg; rewrite ?ltrBrDl ?lerBlDl.
 - move=> x y ax1x xy.
   have t z : z = (z - a) + a by rewrite addrNK.
   rewrite {2}(t y) {2}(t x).
   rewrite -!(translate_polq l) (_ : y - x = y - a - (x - a)); last first.
     by rewrite [x + _]addrC opprD opprK addrA addrNK.
-  by apply: sl; rewrite ?ler_subr_addl ?ltr_le_sub.
+  by apply: sl; rewrite ?lerBrDl ?ltr_leD.
 Qed.
 
 Lemma one_root1_translate {R : archiFieldType} (l : {poly R}) a b c :
@@ -80,21 +80,21 @@ Lemma one_root1_translate {R : archiFieldType} (l : {poly R}) a b c :
 Proof.
 move=> [x1 [x2 [k [[ax1 x1x2 x2b kp] pos neg sl]]]].
 exists (c + x1), (c + x2), k; split.
-- by rewrite !ltr_add2l.
+- by rewrite !ltrD2l.
 - move=> x cax xcx1; rewrite (_ : x = x - c + c); last by rewrite addrNK.
-  by rewrite -translate_polq; apply pos; rewrite ?ltr_subr_addl ?ler_subl_addl.
+  by rewrite -translate_polq; apply pos; rewrite ?ltrBrDl ?lerBlDl.
 - move=> x cx2x xcb; rewrite (_ : x = x - c + c); last by rewrite addrNK.
   rewrite -translate_polq; apply: neg; rewrite -?ler_addlA //.
-    by rewrite ltr_subr_addl.
-  by rewrite ltr_subl_addl.
+    by rewrite ltrBrDl.
+  by rewrite ltrBlDl.
 - move=> x y cx1x xy ycx2.
   have t z : z = (z - c) + c by rewrite addrNK.
   rewrite {2}(t x) {2}(t y) (_ : y - x = y - c - (x - c)); last first.
     by rewrite [x + _]addrC opprD opprK addrA addrNK.
-  rewrite -!(translate_polq l); apply: sl; rewrite ?ler_add2l.
-  + by rewrite ltr_subr_addl.
-  + by rewrite ler_sub.
-  + by rewrite ltr_subl_addl.
+  rewrite -!(translate_polq l); apply: sl; rewrite ?lerD2l.
+  + by rewrite ltrBrDl.
+  + by rewrite lerB.
+  + by rewrite ltrBlDl.
 Qed.
 
 Lemma diff_xn_ub {R : archiFieldType} (n : nat) :
@@ -110,12 +110,12 @@ exists (z * k + z ^+ n) => [| x y x0 xy yz].
 rewrite !exprS.
 rewrite (_: _ * _ - _ =  y * (y ^+ n - x ^+ n) + (y - x) * x ^+ n); last first.
   by rewrite mulrDr mulrDl addrA mulrN mulNr addrNK.
-rewrite [_ * (y-x)]mulrDl ler_add //=.
+rewrite [_ * (y-x)]mulrDl lerD //=.
   rewrite -mulrA (@le_trans _ _ (y * (k * (y - x))))//.
-    rewrite (ler_wpmul2l (le_trans (ltW x0) xy))//.
+    rewrite (ler_wpM2l (le_trans (ltW x0) xy))//.
     exact: kp.
-  by rewrite !(mulrCA _ k) ler_wpmul2l// ler_wpmul2r// subr_ge0.
-rewrite (mulrC (_ - _)) ler_wpmul2r ?subr_ge0// ler_expn2r//.
+  by rewrite !(mulrCA _ k) ler_wpM2l// ler_wpM2r// subr_ge0.
+rewrite (mulrC (_ - _)) ler_wpM2r ?subr_ge0// lerXn2r//.
 - by rewrite nnegrE ltW.
 - by rewrite nnegrE ltW.
 - exact: le_trans yz.
@@ -133,7 +133,7 @@ Proof.
 move=> p; exists (eps / 2%:R), (eps / 2%:R).
 have p1 : (0 < eps / 2%:R)%R by rewrite divr_gt0// ltr0n.
 have cmp : eps / 2%:R < eps.
-   by rewrite ltr_pdivr_mulr// ?ltr0n// ltr_pmulr// ltr1n.
+   by rewrite ltr_pdivrMr// ?ltr0n// ltr_pMr// ltr1n.
 split => //.
 by rewrite -splitr.
 Qed.
@@ -149,16 +149,16 @@ have [->|ln0] := eqVneq l 0%R.
   have [->|an0] := eqVneq a 0%R; first by rewrite normr0 big_ord0.
   by rewrite big_ord1 /= expr0 mulr1 coefC eqxx.
 rewrite size_MXaddC (negbTE ln0) /= big_ord_recl expr0 mulr1.
-rewrite (le_trans (ler_norm_add _ _))//.
+rewrite (le_trans (ler_normD _ _))//.
 rewrite coefD coefMX eqxx add0r coefC eqxx hornerE [X in X <= _]addrC.
-rewrite ler_add// !hornerE.
+rewrite lerD// !hornerE.
 have exteq (i : 'I_(size l)) : true ->
     `|(l * 'X + a%:P)`_(lift ord0 i)| * x ^+ lift ord0 i =
     (`|l`_i| * x ^+ i) * x.
   move=> _; rewrite lift0 coefD coefC /= addr0 coefMX /=.
   by rewrite exprS (mulrC x) mulrA.
 rewrite normrM (ger0_norm xge0).
-by rewrite (eq_bigr _ exteq) -mulr_suml ler_wpmul2r.
+by rewrite (eq_bigr _ exteq) -mulr_suml ler_wpM2r.
 Qed.
 
 Lemma cm3 {R : realFieldType} (b : R) :
@@ -174,14 +174,14 @@ rewrite [A in `|A|](_ : _ = l.[y] * y - l.[y] * x + l.[y] * x - l.[x] * x);
   last by rewrite -[_ - _ + _]addrA addNr addr0.
 have py : (0 <= y)%R by rewrite (le_trans xge0).
 have psyx : (0 <= y - x)%R by rewrite subr_ge0.
-rewrite -addrA (le_trans (ler_norm_add _ _)) //.
+rewrite -addrA (le_trans (ler_normD _ _)) //.
 rewrite -mulrBr -mulrBl !normrM (ger0_norm xge0) (ger0_norm psyx).
-rewrite [X in _ <= X]mulrDl ler_add//.
-  rewrite ler_wpmul2r// (le_trans (ler_horner_norm_pol l y py))//.
+rewrite [X in _ <= X]mulrDl lerD//.
+  rewrite ler_wpM2r// (le_trans (ler_horner_norm_pol l y py))//.
   apply: ler_sum => i _.
-  rewrite ler_wpmul2l ?normr_ge0//.
-  by rewrite ler_expn2r// nnegrE (le_trans _ yb).
-rewrite mulrAC ler_pmul//; first exact: cp.
+  rewrite ler_wpM2l ?normr_ge0//.
+  by rewrite lerXn2r// nnegrE (le_trans _ yb).
+rewrite mulrAC ler_pM//; first exact: cp.
 by rewrite (le_trans xy).
 Qed.
 
@@ -192,7 +192,7 @@ move=> [x1 [k [x1gt1 kp neg sl]]].
 have x10 : (0 < x1)%R by rewrite (lt_trans _ x1gt1)// ltr01.
 set y' := x1 - (reciprocal_pol l).[x1] / k.
 have y'1 : x1 < y'.
-  rewrite /y' -(ltr_add2l (-x1)) addNr addrA addNr add0r -mulNr.
+  rewrite /y' -(ltrD2l (-x1)) addNr addrA addNr add0r -mulNr.
   by rewrite divr_gt0 // oppr_gt0; exact: neg.
 have nx1 : (reciprocal_pol l).[x1] < 0%R by apply: neg; rewrite // ltxx.
 have y'pos : (0 <= (reciprocal_pol l).[y'])%R.
@@ -207,10 +207,10 @@ have [u' u1 u'u] : exists2 u', (1 <= u')%R & (u <= u')%R.
   by exists 1%R; rewrite ?lexx // ltW // ltNge cmp.
 have u'0 : (0 < u')%R by apply: lt_le_trans u1.
 have divu_ltr (x : R) : (0 <= x)%R -> (x / u' <= x)%R.
-  by move=> x0; rewrite ler_pdivr_mulr// ler_pemulr.
+  by move=> x0; rewrite ler_pdivrMr// ler_peMr.
 have y'0 : (0 < y')%R by apply: lt_trans y'1.
 pose y := y' + 1.
-have y'y : y' < y by rewrite /y ltr_addl ltr01.
+have y'y : y' < y by rewrite /y ltrDl ltr01.
 have y1 : x1 < y by apply: lt_trans y'1 _.
 have ypos : (0 < (reciprocal_pol l).[y])%R.
   apply: le_lt_trans y'pos _=> /=.
@@ -245,28 +245,28 @@ have [b [b'b clb blty]] : exists b, [/\ b' < b, c * (b - b') < e2 & b <= y].
   have [e3 [e4 [e3p e4p e3e4e2 e3e2 e4e2]]] := cut_epsilon _ e2p.
   case cmp : (b' + e2 / c <= y).
     exists (b' + e3 / c); split.
-    - by rewrite ltr_addl// divr_gt0.
+    - by rewrite ltrDl// divr_gt0.
     - by rewrite (addrC b') addrK mulrA (mulrC c) mulfK // gt_eqF.
-    - apply: le_trans cmp; rewrite ler_add2l//.
-      by rewrite ler_pmul// ltW// invr_gt0.
+    - apply: le_trans cmp; rewrite lerD2l//.
+      by rewrite ler_pM// ltW// invr_gt0.
   exists y; split => //.
   - by rewrite (le_lt_trans b'y').
-  - by rewrite mulrC -ltr_pdivl_mulr// ltr_subl_addl ltNge cmp.
+  - by rewrite mulrC -ltr_pdivlMr// ltrBlDl ltNge cmp.
 pose n := ((size l))%:R - 1.
 have b'0 : (0 < b')%R by apply: lt_trans ab.
 have b0 : (0 < b)%R by apply: lt_trans b'b.
 have b'v0 : (0 < b'^-1)%R by rewrite invr_gte0.
 have bv0 : (0 < b^-1)%R by rewrite invr_gte0.
-have bb'v : b^-1 < b'^-1 by rewrite ltf_pinv.
+have bb'v : b^-1 < b'^-1 by rewrite ltf_pV2.
 exists b^-1, a^-1, k'; split => //.
 - split => //.
-  + by rewrite (lt_le_trans bb'v)// lef_pinv// ltW.
+  + by rewrite (lt_le_trans bb'v)// lef_pV2// ltW.
   + by rewrite invf_lt1// (lt_le_trans _ x1a).
 - move => x x0 xb.
   have xv0 : (0 < x^-1)%R by rewrite invr_gt0.
   have xexp0 : (0 < x^-1 ^+ (size l - 1))%R by rewrite exprn_gt0.
   have b'x : b' < x^-1.
-    by rewrite -(invrK b')// ltf_pinv// (le_lt_trans _ bb'v).
+    by rewrite -(invrK b')// ltf_pV2// (le_lt_trans _ bb'v).
   rewrite -(pmulr_rgt0 _ xexp0) -{2}[x]invrK -horner_reciprocal; last first.
     by rewrite unitfE gt_eqF.
   apply: (le_lt_trans posb'); rewrite -subr_gte0 /=.
@@ -276,12 +276,12 @@ exists b^-1, a^-1, k'; split => //.
 - move => x a1x xlt1.
   have x0 : (0 < x)%R by apply: lt_trans a1x; rewrite invr_gt0.
   have xv0 : (0 < x^-1)%R by rewrite invr_gt0.
-  have x1a0 : (x^-1 < a)%R by rewrite -[a]invrK ltf_pinv// posrE// invr_gt0.
+  have x1a0 : (x^-1 < a)%R by rewrite -[a]invrK ltf_pV2// posrE// invr_gt0.
   have xexp0 : (0 < x^-1 ^+ (size l - 1))%R by apply: exprn_gt0.
   rewrite -(pmulr_rlt0 _ xexp0) -{2}[x]invrK -horner_reciprocal//; last first.
     by rewrite unitfE gt_eqF.
   case cmp: (x^-1 <= x1); last (move/negbT:cmp => cmp).
-    by apply: neg => //; rewrite -invr1 ltf_pinv// ?posrE ltr01//.
+    by apply: neg => //; rewrite -invr1 ltf_pV2// ?posrE ltr01//.
   apply: lt_trans nega; rewrite -subr_gte0.
   apply: lt_le_trans (_ : k * (a - x^-1) <= _).
     by rewrite mulr_gt0// subr_gt0.
@@ -313,34 +313,34 @@ exists b^-1, a^-1, k'; split => //.
     by rewrite gt_eqF// ltr0n.
   rewrite (_ : k' = k1 + k2); last by rewrite /k1 /k2 addrA addNr add0r.
   have x1ltvz : x1 < z ^-1.
-    by rewrite (le_lt_trans x1a) // -[a]invrK ltef_pinv ?posrE ?invr_gt0 ?ltW.
-  rewrite mulrDl; apply: ler_add; last first.
+    by rewrite (le_lt_trans x1a) // -[a]invrK ltef_pV2 ?posrE ?invr_gt0 ?ltW.
+  rewrite mulrDl; apply: lerD; last first.
     have maj' : t3 * y^-1 ^+ (size l - 1) <= t3 * z^+ (size l - 1).
       have maj : y^-1 ^+(size l - 1) <= z ^+ (size l - 1).
         case: (size l - 1)%N => [ | n']; first by rewrite !expr0 lexx.
         have /pow_monotone : (0 <= y ^-1 <= z)%R.
           rewrite ltW /=; last by rewrite invr_gt0 (lt_trans x10).
           apply: ltW (le_lt_trans _ xz); apply: ltW (le_lt_trans _ bvx).
-          by rewrite lef_pinv ?posrE.
+          by rewrite lef_pV2 ?posrE.
         by move=> /(_ n'.+1) /andP[].
-      rewrite lter_pmul2l // /t3.
+      rewrite lter_pM2l // /t3.
       apply: (lt_le_trans _ (_ : k * (x ^-1 - z ^-1) <= _)); last first.
         apply: sl; first by apply: ltW.
-        by rewrite ltf_pinv.
-      by rewrite mulr_gt0 // subr_gt0 ltf_pinv.
+        by rewrite ltf_pV2.
+      by rewrite mulr_gt0 // subr_gt0 ltf_pV2.
     apply: le_trans maj'; rewrite /t3 k2p mulrAC.
-    rewrite lter_pmul2r; last by apply: exprn_gt0; rewrite invr_gt0.
+    rewrite lter_pM2r; last by apply: exprn_gt0; rewrite invr_gt0.
     apply: ltW (lt_le_trans _ (_ :k * (x ^-1 - z ^-1) <= _)).
-      rewrite ![k * _]mulrC mulrAC lter_pmul2r; last by [].
+      rewrite ![k * _]mulrC mulrAC lter_pM2r; last by [].
       rewrite -[x ^-1](mulrK (unitf_gt0 z0)).
       rewrite  -[X in _ < _ - X](mulrK (unitf_gt0 x0)) -(mulrC x) -(mulrC z).
       rewrite (mulrAC x) -!(mulrA _ (x^-1)) -mulrBl (mulrC (z - x)).
-      rewrite lter_pmul2r; last by rewrite subr_gte0.
-      apply: lt_le_trans (_ : x1 / z <= _); first by rewrite lter_pmul2l.
-      rewrite lter_pmul2r; last by rewrite invr_gte0.
-      by apply: ltW (lt_trans x1ltvz _); rewrite ltef_pinv ?posrE.
+      rewrite lter_pM2r; last by rewrite subr_gte0.
+      apply: lt_le_trans (_ : x1 / z <= _); first by rewrite lter_pM2l.
+      rewrite lter_pM2r; last by rewrite invr_gte0.
+      by apply: ltW (lt_trans x1ltvz _); rewrite ltef_pV2 ?posrE.
     apply: sl; first by apply: ltW.
-    by rewrite ltef_pinv ?posrE.
+    by rewrite ltef_pV2 ?posrE.
   rewrite /t1/k1/k' {t2 t3}.
   have xzexp : (x ^+ (size l - 1) <= z ^+ (size l - 1)).
     case sizep : (size l - 1)%N => [ | n'].
@@ -350,39 +350,39 @@ exists b^-1, a^-1, k'; split => //.
     by move=>/(_ n'.+1)=> /andP[].
   case: (lerP 0 ((reciprocal_pol l).[x^-1])) => sign; last first.
     apply: le_trans (_ : 0 <= _)%R.
-      rewrite mulNr lter_oppl oppr0; apply: mulr_ge0; last first.
+      rewrite mulNr lterNl oppr0; apply: mulr_ge0; last first.
         by rewrite subr_gte0 ltW.
       exact (ltW k'p).
     by rewrite nmulr_lge0 // subr_lte0.
-  rewrite mulNr lter_oppl -mulNr opprB.
+  rewrite mulNr lterNl -mulNr opprB.
   have rpxe : (reciprocal_pol l).[x^-1] <= e.
     apply:le_trans (_ : (reciprocal_pol l).[b] <= _) => /=.
       rewrite -subr_gte0 /= ; apply: le_trans (_ : k * (b - x^-1) <= _).
         rewrite mulr_ge0 //.
           exact: ltW.
-        by rewrite subr_ge0 ltW // -(invrK b) ltef_pinv ?posrE.
+        by rewrite subr_ge0 ltW // -(invrK b) ltef_pV2 ?posrE.
       apply: sl.
-        by apply: (ltW (lt_trans x1ltvz _)); rewrite ltef_pinv ?posrE.
-      by rewrite -(invrK b) ltef_pinv ?posrE.
+        by apply: (ltW (lt_trans x1ltvz _)); rewrite ltef_pV2 ?posrE.
+      by rewrite -(invrK b) ltef_pV2 ?posrE.
     rewrite -[_ _ b]addr0 -(addrN ((reciprocal_pol l).[b'])) addrA.
     rewrite (addrC (_.[b])) -addrA; apply: le_trans e1e2e.
-    apply: ler_add; first by [].
+    apply: lerD; first by [].
     apply: (le_trans (ler_norm _)).
     by apply/ltW/(le_lt_trans _ clb)/cp=> //; apply/ltW.
   apply: le_trans (_ : (z^+ (size l - 1) - x ^+ (size l - 1)) * e <= _).
     move: xzexp; rewrite -subr_gte0 le_eqVlt => /predU1P[<-|xzexp] /=.
       by rewrite !mul0r.
-  by rewrite lter_pmul2l.
+  by rewrite lter_pM2l.
 rewrite [_ * e]mulrC; apply: le_trans (_ : e * (u' * (z - x)) <= _)=> /=.
-  rewrite ler_pmul2l//.
+  rewrite ler_pM2l//.
   apply: le_trans (_ : u * (z - x) <= _).
     apply: up => //.
       by apply: ltW.
     apply: ltW (lt_trans zav _).
     by rewrite invf_lt1 //; by apply: lt_le_trans x1a.
-  by rewrite ler_pmul2r// subr_gt0.
+  by rewrite ler_pM2r// subr_gt0.
 rewrite mulrA.
-rewrite ler_pmul2r// ?subr_gt0//.
+rewrite ler_pM2r// ?subr_gt0//.
 by rewrite /e divrK// unitfE gt_eqF.
 Qed.
 
diff --git a/theories/casteljau.v b/theories/casteljau.v
index 8884ba5..9b2ec04 100644
--- a/theories/casteljau.v
+++ b/theories/casteljau.v
@@ -1,5 +1,5 @@
 From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat binomial seq choice order.
-From mathcomp Require Import fintype bigop ssralg poly ssrnum ssrint rat ssrnum.
+From mathcomp Require Import fintype bigop ssralg poly ssrnum ssrint rat ssrnum archimedean.
 From mathcomp Require Import polyrcf qe_rcf_th realalg.
 Require Import pol poly_normal desc.
 
@@ -43,15 +43,15 @@ Lemma normr_sum : forall m  (G : nat -> F),
   `|\sum_(i < m) G i| <= \sum_(i < m) `|G i|.
 Proof.
 elim=> [|m ihm] G; first by rewrite !big_ord0 normr0.
-rewrite !big_ord_recr /=; apply: le_trans (ler_norm_add _ _) _=> /=.
-by rewrite ler_add2r; apply: ihm.
+rewrite !big_ord_recr /=; apply: le_trans (ler_normD _ _) _=> /=.
+by rewrite lerD2r; exact: ihm.
 Qed.
 
 Lemma expf_gt1 : forall m (x : F), x > 1 -> x^+m.+1 > 1.
 Proof.
 elim => [|m ihm] x hx; first by rewrite expr1.
 apply: lt_trans (hx) _ => /=; rewrite exprS -{1}(mulr1 x).
-rewrite ltr_pmul2l; first exact: ihm.
+rewrite ltr_pM2l; first exact: ihm.
 apply: lt_trans hx; exact: ltr01.
 Qed.
 
@@ -59,7 +59,7 @@ Lemma expf_ge1 : forall m (x : F), x >= 1 -> x^+m >= 1.
 Proof.
 elim => [|m ihm] x hx; first by rewrite expr0 lexx.
 apply: le_trans (hx) _ => /=; rewrite exprS. (* -{1}(mulr1 x). *)
-rewrite ler_pmulr; first exact: ihm.
+rewrite ler_pMr; first exact: ihm.
 apply: lt_le_trans hx; exact: ltr01.
 Qed.
 
@@ -125,8 +125,8 @@ Proof.
 move=> px0; case: (lerP `|x| 1)=> cx1.
   set C := _ * _; suff leC1 : 1 <= C by apply: le_trans leC1.
   have h1 : `|E n| > 0 by rewrite  normr_gt0.
-  rewrite -(ler_pmul2l h1) /= mulr1 /C mulrA mulfV ?normr_eq0 // mul1r.
-  by rewrite big_ord_recr /= -{1}(add0r `|E n|) ler_add2r sumr_ge0.
+  rewrite -(ler_pM2l h1) /= mulr1 /C mulrA mulfV ?normr_eq0 // mul1r.
+  by rewrite big_ord_recr /= -{1}(add0r `|E n|) lerD2r sumr_ge0.
 case e: n=> [| m].
   move: pnz; rewrite -px0 e horner_poly big_ord_recl big_ord0 /=.
   by rewrite addr0 expr0 mulr1 /= eqxx.
@@ -145,13 +145,13 @@ have xmn0 : ~~ (x^+m == 0) by rewrite expf_eq0 x0 andbF.
 have h3 : `|\sum_(i < m.+1) E i / x ^+ (m - i) | <= \sum_(i < m.+2) `|E i|.
   apply: le_trans (normr_sum m.+1 (fun i =>  E i / x ^+ (m - i))) _.
   apply: (@le_trans _ _ (\sum_(i < m.+1) `|E i|)); last first.
-    by rewrite (big_ord_recr m.+1) /= ler_addl /= normr_ge0.
+    by rewrite (big_ord_recr m.+1) /= lerDl /= normr_ge0.
   suff h: forall i, (i < m.+1)%N -> `|E i/x^+(m-i)| <= `|E i|.
     by apply: ler_sum => //= i _; exact: h.
-  move=> i lti; rewrite normrM -{2}(mulr1 (`|E i|)) ler_wpmul2l ?normr_ge0 //.
+  move=> i lti; rewrite normrM -{2}(mulr1 (`|E i|)) ler_wpM2l ?normr_ge0 //.
   rewrite normfV normrX invf_le1; first by rewrite exprn_cp1 // ltW.
   by rewrite exprn_gt0 // (lt_trans ltr01).
-rewrite lter_pdivl_mull; last by rewrite normr_gt0 -e.
+rewrite lter_pdivlMl; last by rewrite normr_gt0 -e.
 by apply: le_trans h3=> /=; rewrite -normrM h2 normrN lexx.
 Qed.
 
@@ -1284,24 +1284,24 @@ set q := \poly_(_ < _) _; move=> pq.
 have [ub pu] := (poly_itv_bound (q \Po ('X - a%:P)) a b).
 have ub0 : 0 <= ub by rewrite (le_trans _ (pu a _)) // lexx andTb ltW.
 set ub' := ub + 1.
-have ub'0 : 0 < ub' by rewrite ltr_paddl.
-have ublt : ub < ub' by rewrite ltr_spaddr // ltr01.
+have ub'0 : 0 < ub' by rewrite ltr_wpDl.
+have ublt : ub < ub' by rewrite ltr_pwDr // ltr01.
 pose x := minr (a - p.[a]/ub') (half (a + b)).
 have xitv2 : a < x < b.
-  by case/andP: (mid_between ab)=> A B; rewrite lt_minr ltr_spaddr ?A //=
+  by case/andP: (mid_between ab)=> A B; rewrite lt_min ltr_pwDr ?A //=
     ?lt_minl ?B ?orbT // -mulNr mulr_gt0 // ?invr_gt0 // oppr_gt0.
 have xitv : a <= x <= b by case/andP: xitv2 => *; rewrite !ltW //.
 have := cp _ xitv2.
 rewrite [X in X.[x]]pq hornerD hornerC hornerM hornerXsubC.
 rewrite -[X in 0 <  _ + X]opprK subr_gt0 => abs.
-have : x - a <= -p.[a] / ub' by rewrite ler_subl_addl le_minl mulNr lexx.
-rewrite -(ler_pmul2r ub'0) mulfVK; last first.
+have : x - a <= -p.[a] / ub' by rewrite lerBlDl ge_min mulNr lexx.
+rewrite -(ler_pM2r ub'0) mulfVK; last first.
   by move:ub'0; rewrite lt0r=>/andP=>[[]].
 have xma :0 < x - a by rewrite subr_gt0; case/andP: xitv2.
 move: (pu _ xitv); rewrite lter_norml; case/andP => _ {pu}.
-rewrite -[_ <= ub](ler_pmul2r xma) => pu2.
+rewrite -[_ <= ub](ler_pM2r xma) => pu2.
 rewrite mulrC; have := (lt_le_trans abs pu2) => {pu2} {}abs ab'.
-have := (le_lt_trans ab' abs); rewrite ltr_pmul2r // ltNge;case/negP.
+have := (le_lt_trans ab' abs); rewrite ltr_pM2r // ltNge;case/negP.
 by rewrite ltW.
 Qed.
 
@@ -1314,10 +1314,10 @@ move=> itv1 itv2 sl.
 case/andP: itv=> ac; case/andP=> cd; case/andP=> db k0.
 have qd0 : q.[d] <= 0.
   have : (0 <= (-q).[d]).
-    by apply: (poly_border db) => x xitv; rewrite hornerN lter_oppE itv2.
-  by rewrite hornerN lter_oppE.
+    by apply: (poly_border db) => x xitv; rewrite hornerN lterNE itv2.
+  by rewrite hornerN lterNE.
 have qc0 : 0 <= q.[c] by apply/ltW/itv1; rewrite ac lexx.
-have qcd0 : (-q).[c] <= 0 <= (-q).[d] by rewrite !hornerN !lter_oppE qd0 qc0.
+have qcd0 : (-q).[c] <= 0 <= (-q).[d] by rewrite !hornerN !lterNE qd0 qc0.
 have [x xin] := (poly_ivt (ltW cd) qcd0).
 rewrite /root hornerN oppr_eq0 =>/eqP => xr.
 exists x; split.
@@ -1337,12 +1337,12 @@ exists x; split.
   case/andP: xin=> cx xd.
   case ux : (u <= x).
     have := (sl _ _ cu' ux xd).
-    rewrite qu0 xr subrr -(mulr0 k) ler_pmul2l // subr_le0 => xu.
+    rewrite qu0 xr subrr -(mulr0 k) ler_pM2l // subr_le0 => xu.
     by apply/eqP; rewrite eq_le ux.
   have xu : x <= u.
     by apply: ltW; rewrite ltNge ux.
     have := (sl _ _ cx xu ud').
-    rewrite qu0 xr subrr -(mulr0 k) ler_pmul2l // subr_le0 => ux'.
+    rewrite qu0 xr subrr -(mulr0 k) ler_pM2l // subr_le0 => ux'.
   by apply/eqP; rewrite eq_le ux'.
 Qed.
 
@@ -1420,7 +1420,7 @@ case h0: (head 0 (seqn0 l) == 0); move: (h0).
   by move: al0; apply: sub_all => x x0; rewrite (eqP x0) lexx.
 move=> _ /eqP; rewrite (ltW hsn0) addn_eq0 /= => /andP [p1]/eqP.
 apply: IH.
-rewrite lt_neqAle h0 /= -(ler_nmul2l hsn0) mulr0.
+rewrite lt_neqAle h0 /= -(ler_nM2l hsn0) mulr0.
 by move: p1; rewrite eqb0 ltNge negbK.
 Qed.
 
@@ -1435,7 +1435,7 @@ case h0: (head 0 (seqn0 l) == 0); move: (h0).
 move=> _ /eqP; rewrite hsn0 addn_eq0 /= => /andP [p1]/eqP.
 apply: IH.
 have hsn0' : 0 < a by rewrite lt_neqAle eq_sym a0.
-rewrite  -(ler_pmul2l hsn0') mulr0.
+rewrite -(ler_pM2l hsn0') mulr0.
 by move: p1; rewrite eqb0 ltNge negbK.
 Qed.
 
@@ -1467,7 +1467,7 @@ case alt: (a * head 0 (seqn0 l) < 0)%R; last first.
   have alt' : alternate (\sum_(i < d.+1) (l`_i * f i.+1) *: 'X^(d - i)).
     apply: (IH l (fun i => f i.+1)) => //.
     have agt0 : 0 < a by rewrite lt_neqAle eq_sym (negbTE h).
-    rewrite -(ler_pmul2l agt0) mulr0 leNgt; apply: negbT; exact alt.
+    rewrite -(ler_pM2l agt0) mulr0 leNgt; apply: negbT; exact alt.
   rewrite big_ord_recl subn0 nth0 /= addrC; apply: alternate_r => //.
     rewrite pmulr_lgt0; first by rewrite lt_neqAle eq_sym h h4.
     by apply: h2.
@@ -1478,7 +1478,7 @@ case alt: (a * head 0 (seqn0 l) < 0)%R; last first.
 rewrite add1n; move=> sl cf [c0] ap.
 have negl : head 0 (seqn0 l) < 0.
   have ap' : 0 < a by rewrite lt_neqAle eq_sym h ap.
-  by rewrite -(ltr_pmul2l ap') mulr0 alt.
+  by rewrite -(ltr_pM2l ap') mulr0 alt.
 have int: head 0 (seqn0 l) != 0 by rewrite neq_lt negl.
 move/seqn0_last: (int) => [l1 [x [l2 /andP [/eqP p1 /andP[p2 p3]]]]].
 apply/alternate_P; rewrite /= -/R.
@@ -1640,7 +1640,7 @@ wlog : l q / (0 <= (seqn0 l)`_0).
   have ur : unique_root_for (horner (-q)) a b.
     apply: (main (map (fun x => -x) l) (-q)) => //.
           rewrite seqn0_oppr (nth_map 0).
-            by rewrite ler_oppr oppr0 ltW // ltNge sg.
+            by rewrite lerNr oppr0 ltW // ltNge sg.
           rewrite lt0n; apply/negP; move/eqP=>abs; move: sg.
           by rewrite nth_default ?abs ?lexx.
         by rewrite size_map.
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index b869668..031ce72 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -952,7 +952,7 @@ split.
   case futq : future_events => [ | ev2 fut']; first by left.
   right; rewrite /=.
   apply: svaln.
-      by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite map_f // futq inE eqxx.
+      by apply: (@allP pt _ _ inbox_es); rewrite map_f // futq inE eqxx.
     apply: lexPtW.
     by move: sort_evs; rewrite futq /= => /andP[].
   move=> e'; rewrite futq inE => /orP[/eqP -> | ].
@@ -1395,7 +1395,7 @@ split.
     rewrite path_sortedE; last by move=> x y z; apply: lexPt_trans.
     by move=> /andP[] /allP /(_ e') + _; apply.
   have inbox_e2 : inside_box (point e2).
-    by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite futq /= inE eqxx.
+    by apply: (@allP pt _ _ inbox_es); rewrite futq /= inE eqxx.
   right.
   apply/andP; split; last first.
     rewrite -!all_cat fc'0 cats0; apply/allP=> x xin.
@@ -1406,7 +1406,7 @@ split.
     have /andP[eelx eehx] :
      end_edge_ext bottom top (low x) future_events &&
      end_edge_ext bottom top (high x) future_events.
-      apply: (allP clae_part). 
+      apply: (allP clae_part).
       by rewrite /open'; move: xin; rewrite mem_cat=>/orP[] ?; subset_tac.
     by rewrite !(valid_between_events elexe2 e2lexfut _ inbox_e2).
   have eelo : end_edge_ext bottom top (low lsto) future_events.
@@ -1979,7 +1979,7 @@ have p1e : p1 = (point e).
     have eonlsthe' : point e === high lsto.
       by apply: under_above_on=> //; rewrite -lstheq // ?underW.
     by have /eqP := on_edge_same_point eonlsthe' p1on samex.
-  by apply/esym/(@eqP [eqType of pt]); rewrite pt_eqE samex samey.
+  by apply/esym/(@eqP pt); rewrite pt_eqE samex samey.
 rewrite p1e /generic_trajectories.pvert_y subrr -strict_under_pvert_y //.
 by rewrite puh -pxe pvert_on.
 Qed.
@@ -1993,7 +1993,7 @@ Lemma step_keeps_open_disjoint :
   {in state_open_seq (step (Bscan fop lsto lop cls lstc lsthe lstx) e) &,
      disjoint_open_cells R}.
 Proof.
-have := step_keeps_invariant1; rewrite /invariant1/inv1_seq. 
+have := step_keeps_invariant1; rewrite /invariant1/inv1_seq.
 set s' := (state_open_seq _) => -[clae' [sval' [adj' [cbtom' srf']]]].
 have := step_keeps_pw; rewrite -/s' => /= /andP[] _ pw'.
 have := step_keeps_open_side_limit; rewrite -/s'=> ok'.
@@ -2494,7 +2494,7 @@ rewrite inE => /orP[/eqP -> | ].
     rewrite /=.
     move=> /on_edge_same_point /[apply] /=.
     rewrite xcond /left_limit lptsq /= eqxx => /(_ isT) /eqP ->.
-    by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+    by apply/(@eqP pt); rewrite pt_eqE /= !eqxx.
   by [].
 move=> c1in; exists c1; first by rewrite inE c1in orbT.
 by left.
@@ -2760,7 +2760,7 @@ case ogq : (outgoing e) => [ | fog og]; last first.
     by apply: (allP open_side_limit); rewrite /open mem_cat inE eqxx orbT.
   move=> /andP[] _ /andP[] A /andP[] _ /andP[] _ onlow.
   rewrite pxhere lstxq /left_limit lptsq /=.
-  apply/(@eqP [eqType of pt]); rewrite pt_eqE /= eqxx /= eq_sym; apply/eqP.
+  apply/(@eqP pt); rewrite pt_eqE /= eqxx /= eq_sym; apply/eqP.
   have -> : pvert_y (point e) (low lsto) = pvert_y (last sp lpts) (low lsto).
     apply: same_pvert_y=> //.
     by rewrite pxhere lstxq /left_limit lptsq.
@@ -2814,14 +2814,14 @@ have yin' : y \in cls ++ lstc :: rcons (closing_cells (point e) cc)
   by case: (cc) => //= ? ?; rewrite inE=> ->; rewrite ?orbT.
 move: xin; rewrite !(mem_cat, mem_rcons, inE)=> /orP[xin | ].
   apply: clopcnd; first by rewrite !(mem_cat, mem_rcons, inE) xin.
-  by rewrite cat_rcons.  
+  by rewrite cat_rcons.
 move=>/orP[/eqP -> | xin]; last first.
   apply: clopcnd.
     by rewrite !(mem_cat, mem_rcons, inE) xin !orbT.
   by rewrite cat_rcons.
 move=> q.
 move: clopcnd; set w := (X in _ ++ X :: _).
-have nlstoq : nlsto = set_pts w                      
+have nlstoq : nlsto = set_pts w
    (Bpt (p_x (point e)) (pvert_y (point e) he) :: left_pts lsto)
    (right_pts lsto).
    by rewrite /nlsto /generic_trajectories.pvert_y subrr.
@@ -2834,7 +2834,7 @@ rewrite /w /=.
 have /andP[] := allP open_side_limit lsto lstoin.
 case plstq : (left_pts lsto) => [ // | a l] _ /= /andP[] A /andP[] _ /andP[] _.
 move: lstxq; rewrite /left_limit plstq /= => sx one.
-apply/(@eqP [eqType of pt]); rewrite pt_eqE /= pxhere sx eqxx /=.
+apply/(@eqP pt); rewrite pt_eqE /= pxhere sx eqxx /=.
 rewrite -(on_pvert one).
 apply/eqP; apply: same_pvert_y; first by case/andP: one.
 by rewrite pxhere sx.
@@ -3485,7 +3485,7 @@ case ogq : (outgoing e) => [ | fog ogs]; last first.
 move=> [] nosq lnoq.
 have oca_eq : opening_cells_aux (point e) (sort (@edge_below _) (outgoing e))
    le he =
-  ([::], (Bcell (@no_dup_seq [eqType of pt]
+  ([::], (Bcell (@no_dup_seq pt
       [:: (Bpt (p_x (point e)) (pvert_y (point e) he));
           (point e);
           (Bpt (p_x (point e)) (pvert_y (point e) le))]) [::] le he)).
@@ -3982,7 +3982,7 @@ move=> g [ | ]; last first.
   rewrite -ogq in oca_eq.
   move=> [] <- <-.
   have [oc [P1 [P2 P3]]] := opening_cells_aux_cover_outgoing vlo oca_eq go.
-  left; exists (if oc == fno then 
+  left; exists (if oc == fno then
                   set_left_pts fno (point e :: behead (left_pts lsto))
                 else oc), [::].
   split;[by [] | split;[ | split; [by [] | ]]].
@@ -3996,7 +3996,7 @@ move=> g [ | ]; last first.
     by move: P1; rewrite inE ocnfno /= !(mem_cat, inE)=> ->; rewrite !orbT.
   rewrite /=; case: ifP => [ocfno | ocnfno]; last by [].
   move: lstxq; rewrite /left_limit ptsq -pxhere /= => <-.
-  by apply/f_equal/esym/(@eqP [eqType of pt])/oute.
+  by apply/f_equal/esym/(@eqP pt)/oute.
 move=> [ | [pcc [P0 [P1 [P2 [P3 [P4 P5]]]]]]]; last first.
   move: uoct_eq; rewrite /update_open_cell_top/generic_trajectories.update_open_cell_top.
   case ogq : (outgoing e) => [ | fog ogs].
@@ -4765,12 +4765,12 @@ have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have [-> -> _] := close_cell_preserve_3sides (point e) lcc.
 rewrite -heq.
 have eonllcc : (point e) === low lcc.
-  have := open_cells_decomposition_point_on cbtom adj 
+  have := open_cells_decomposition_point_on cbtom adj
             (inside_box_between inbox_e) sval oe.
   elim /last_ind: {-1} (cc) (erefl cc) ccn0 => [ | cc' cc2 _] ccq // _.
   have : cc2 \in rcons cc' cc2 by rewrite mem_rcons mem_head.
   move=> + /(_ cc2) =>/[swap] /[apply].
-  move: adj; rewrite ocd ccq cat_rcons; do 2 move =>/adjacent_catW[] _. 
+  move: adj; rewrite ocd ccq cat_rcons; do 2 move =>/adjacent_catW[] _.
   by move=> /= /andP[] /eqP ->.
 have vppl : valid_edge (low lcc) pp.
   by rewrite (same_x_valid _ samex).
@@ -4790,7 +4790,7 @@ have ppuhy : (p_y pp == pvert_y (point e) he) = false.
   apply/negbTE; move: (ppuh).
   rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
   by rewrite (same_pvert_y vpphe samex).
-rewrite !(@in_cons [eqType of pt]).
+rewrite !(@in_cons pt).
 rewrite !pt_eqE ppuhy andbF orbF.
 move: ppae; rewrite lt_neqAle eq_sym=>/andP[] /negbTE -> _.
 by rewrite andbF.
@@ -4817,7 +4817,7 @@ have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have [-> -> _] := close_cell_preserve_3sides (point e) cc1.
 rewrite -leq.
 have eonhcc1 : (point e) === high cc1.
-  have := open_cells_decomposition_point_on cbtom adj 
+  have := open_cells_decomposition_point_on cbtom adj
             (inside_box_between inbox_e) sval oe.
   by move=> /(_ cc1 (mem_head _ _)).
 have vpph : valid_edge (high cc1) pp.
@@ -4837,7 +4837,7 @@ have ppaly : (p_y pp == pvert_y (point e) le) = false.
   apply/negbTE; move: (ppal).
   rewrite (under_pvert_y vpple) -ltNge lt_neqAle eq_sym=> /andP[] + _.
   by rewrite (same_pvert_y vpple samex).
-rewrite !(@in_cons [eqType of pt]) !pt_eqE ppaly andbF.
+rewrite !(@in_cons pt) !pt_eqE ppaly andbF.
 move: ppue; rewrite lt_neqAle eq_sym=>/andP[] /negbTE -> _.
 by rewrite andbF.
 Qed.
@@ -4857,7 +4857,7 @@ have /andP[vlc' vhc']: valid_edge (low c') (point e) &&
        valid_edge (high c') (point e).
   by apply: (allP sval); rewrite ocd !(mem_cat, inE) cin !orbT.
 have := right_limit_close_cell vlc' vhc'.
-have allon := open_cells_decomposition_point_on cbtom adj 
+have allon := open_cells_decomposition_point_on cbtom adj
             (inside_box_between inbox_e) sval oe.
 have /allon eonh : c' \in cc1 :: cc by rewrite inE cin orbT.
 have eonl : point e === low c'.
@@ -4922,7 +4922,7 @@ have puhy : p_y (point e) < pvert_y (point e) he.
 have paly :  pvert_y (point e) le < p_y (point e).
   by rewrite ltNge -(under_pvert_y vle).
 rewrite /close_cell/right_pts -leq -heq (pvertE vle) (pvertE vhe).
-rewrite (@mem_no_dup_seq [eqType of pt]) !(@in_cons [eqType of pt]) (negbTE ppne) /=.
+rewrite (@mem_no_dup_seq pt) !(@in_cons pt) (negbTE ppne) /=.
 have [vpple vpphe] : valid_edge le pp /\ valid_edge he pp.
   by rewrite !(same_x_valid _ samex).
 have [pu | ] := ltrP (p_y pp) (p_y (point e)).
@@ -5156,7 +5156,7 @@ have [vb vt] : valid_edge bottom (point ev) /\ valid_edge top (point ev).
     by rewrite inE eqxx.
   by rewrite /= => /andP[].
 have /andP[/andP[pal puh] _] : inside_box bottom top (point ev).
-   by apply: (@allP [eqType of pt] _ _ evin); rewrite evsq map_f// inE eqxx.
+   by apply: (@allP pt _ _ evin); rewrite evsq map_f// inE eqxx.
 have : open_cells_decomposition [:: op0] (point ev) =
   ([::], [::], op0, [::], bottom, top).
   apply: (open_cells_decomposition_single
@@ -5207,7 +5207,7 @@ have oute : out_left_event ev by apply: out_evs.
 have oute' : {in sort (@edge_below _) (outgoing ev), forall g,
                   left_pt g == point ev}.
   by move=> g; rewrite mem_sort; apply: oute.
-have edges_sub1 : {subset all_edges (rcons nos lno) 
+have edges_sub1 : {subset all_edges (rcons nos lno)
         future_events <= [:: bottom, top & s]}.
   move=> g; rewrite mem_cat=> /orP[ | gfut ]; last first.
     have /evsub {}gfut : g \in events_to_edges events.
@@ -5223,7 +5223,7 @@ have edges_sub1 : {subset all_edges (rcons nos lno)
   move=> {}main; apply/orP; right; apply/orP; right.
   by apply/evsub/flattenP; exists (outgoing ev); rewrite // map_f.
 have pin : inside_box bottom top (point ev).
-  by apply: (@allP [eqType of pt] _ _ evin); rewrite evsq /= inE eqxx.
+  by apply: (@allP pt _ _ evin); rewrite evsq /= inE eqxx.
 have inbox_all_events0 :
   all (inside_box bottom top) [seq point x | x <- (ev :: future_events)].
   by move: evin; rewrite evsq.
@@ -5245,7 +5245,7 @@ have lstx1op : lst_x _ _ state1 = left_limit (lst_open state1).
 have sh1 : all (fun ev => lst_x _ _ state1 < p_x (point ev)) future_events &&
           sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) future_events.
   move: ltev; rewrite evsq /= path_sortedE /=; last first.
-    by move=> x y z; apply: lt_trans. 
+    by move=> x y z; apply: lt_trans.
   by rewrite st1q.
 have he1q' : high (lst_open state1) = lst_high _ _ state1.
   rewrite st1q /=.
@@ -5627,7 +5627,7 @@ Lemma initial_edge_covering_general_position
    [:: (head dummy_event events)]
    (initial_state bottom top events) (behead events).
 Proof.
-move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es 
+move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es
   uniq_out_es evsn0.
 rewrite /initial_state.
 have := initial_intermediate gen_pos wf startok nocs' inbox_es lexev sub_es
@@ -5641,7 +5641,7 @@ have oute : out_left_event e by apply: out_es; rewrite evsq inE eqxx.
 move=> Cinv [] ok0 []cbtom0 []adj0 []sval0 []rf0 []inbox_es0 []cle1
          []out_es1 []clae0 []vb []vt []oe0 []nocs []noc0 []pw0 lexevs.
 have inbox_e : inside_box bottom top (point e).
-  by apply/(@allP [eqType of pt] _ _ inbox_es)/map_f; rewrite evsq inE eqxx.
+  by apply/(@allP pt _ _ inbox_es)/map_f; rewrite evsq inE eqxx.
 have /andP[eab ebt] : (point e >>> bottom) && (point e <<< top).
   by move: inbox_e=> /andP[].
 have cle0 : close_edges_from_events (e :: evs) by rewrite -evsq.
@@ -5657,7 +5657,7 @@ have inj_high0 : {in [:: start_open_cell bottom top] &, injective high}.
 have uniq1 : {in evs, forall e, uniq (outgoing e)}.
   by move=> ev evin; apply: uniq_out_es; rewrite evsq inE evin orbT.
 have rf0' : s_right_form ([::] ++ [:: op0]) by [].
-have  btm_left_lex0 : 
+have  btm_left_lex0 :
   bottom_left_cells_lex [:: start_open_cell bottom top] (point e).
   by apply: bottom_left_start inbox_e startok.
 have inj_high1 : {in nos ++ [:: lno] &, injective high}.
@@ -6099,12 +6099,12 @@ have rllt : {in [:: close_cell (point ev) op0] & evs,
   by rewrite right_limit_close_cell //; apply: lte.
 (* Main points. *)
 have safe_cl : {in events_to_edges [:: ev] & [:: close_cell (point ev) op0],
-         forall g c p, in_safe_side_left p c || in_safe_side_right p c -> 
+         forall g c p, in_safe_side_left p c || in_safe_side_right p c ->
          ~ p === g}.
   move=> g c gin.
   have lgq : left_pt g = point ev.
     apply/eqP/oute.
-    by move: gin; rewrite /events_to_edges /= cats0. 
+    by move: gin; rewrite /events_to_edges /= cats0.
   rewrite inE => /eqP -> p /orP[] pin.
     move=> /andP[] _ /andP[] + _.
     rewrite leNgt=> /negP; apply.
@@ -6115,7 +6115,7 @@ have safe_cl : {in events_to_edges [:: ev] & [:: close_cell (point ev) op0],
   rewrite right_limit_close_cell // => /eqP samex.
   move/negP;apply.
   suff -> : p = point ev by rewrite close_cell_in.
-  apply /(@eqP [eqType of pt]); rewrite pt_eqE samex eqxx.
+  apply /(@eqP pt); rewrite pt_eqE samex eqxx.
   apply: (on_edge_same_point pong).
     by rewrite -lgq left_on_edge.
   by apply/eqP.
@@ -6125,16 +6125,16 @@ have safe_op : {in events_to_edges [:: ev] & nos ++ [:: lno],
   move: cin; rewrite cats1=> cin.
   have lgq : left_pt g = point ev.
     apply/eqP/oute.
-    by move: gin; rewrite /events_to_edges /= cats0. 
+    by move: gin; rewrite /events_to_edges /= cats0.
   have eong : point ev === g by rewrite -lgq left_on_edge.
-  move: pin=> /andP[] + /andP[] _ /andP[] _.  
+  move: pin=> /andP[] + /andP[] _ /andP[] _.
   have := opening_cells_left oute vb0 vt0.
   have := opening_cells_in vb0 vt0 oute.
   rewrite /opening_cells oca_eq=> /(_ _ cin) evin /(_ _ cin) -> samex.
   move/negP; apply.
   suff -> : p = point ev.
     by apply: (opening_cells_in vb0 vt0 oute); rewrite /opening_cells oca_eq.
-  apply/(@eqP [eqType of pt]); rewrite pt_eqE samex /=.
+  apply/(@eqP pt); rewrite pt_eqE samex /=.
   by apply: (on_edge_same_point pong eong samex).
 have cl_no_event : {in [:: ev] & [:: close_cell (point ev) op0],
   forall e c (p : pt), in_safe_side_left p c || in_safe_side_right p c ->
diff --git a/theories/civt.v b/theories/civt.v
index a67007e..0cf0f63 100644
--- a/theories/civt.v
+++ b/theories/civt.v
@@ -55,7 +55,7 @@ by rewrite ler_pexpn2r// nnegrE// (le_trans x0).*)
 (*move=> l b; case: l =>[| a l].
 - by exists 0; move=> /= x; rewrite mul0r oppr0 addr0 normr0 lexx.
 - exists (eval_pol (abs_pol l) b) => x px xb /=; rewrite mul0r addr0.
-  rewrite addrC addKr normrM ger0_norm // mulrC ler_wpmul2r//.
+  rewrite addrC addKr normrM ger0_norm // mulrC ler_wpM2r//.
 (* NB(rei): ler_absr_eval_pol? *)
 (*  rewrite (le_trans (ler_absr_eval_pol _ _)) //.
   by rewrite eval_pol_abs_pol_increase // ger0_abs.
diff --git a/theories/conv.v b/theories/conv.v
index d7b4a66..46b2a86 100644
--- a/theories/conv.v
+++ b/theories/conv.v
@@ -68,7 +68,7 @@ apply/andP; split.
    by apply divr_ge0=>//; move:t01=>/andP[].
 have [->|e0] := eqVneq (1 - (1 - t) * (1 - u)) 0; first by rewrite invr0 mulr0; exact ler01.
 rewrite -{4}(divff e0).
-rewrite ler_wpmul2r ?invr_ge0//.
+rewrite ler_wpM2r ?invr_ge0//.
 rewrite mulrBr mulr1 mulrBl -addrA opprD addrA subrr add0r opprB opprK -mulrBl -subr_ge0 -addrA subrr addr0; apply mulr_ge0; last by move:u01=>/andP[].
 by move:t01; rewrite in01_onem=>/andP[].
 Qed.
@@ -157,7 +157,7 @@ move=>/andP[t0 t1] /andP[u0 u1] /andP[v0 v1]; apply/andP; split.
    apply addr_ge0; apply mulr_ge0=>//.
    by rewrite subr_ge0.
 have<-: t + (1-t) = 1 by rewrite addrCA subrr addr0.
-apply ler_add; rewrite -subr_ge0.
+apply: lerD; rewrite -subr_ge0.
    rewrite -{1}[t]mulr1 -mulrBr; apply mulr_ge0=>//.
    by rewrite subr_ge0.
 by rewrite -{1}[1-t]mulr1 -mulrBr; apply mulr_ge0; rewrite subr_ge0.
@@ -209,7 +209,7 @@ have c0: forall x y : R, 0 <= x -> 0 <= y -> (x : R^o) <| t |> y = 0 -> x = 0 /\
       by move=>/eqP->.
    move=>x0 y0 c0.
    suff: 0 < (x : R^o) <| t |> y by rewrite c0 ltxx.
-   rewrite /conv -(addr0 0) ; apply ltr_le_add.
+   rewrite /conv -(addr0 0) ; apply: ltr_leD.
       by apply mulr_gt0.
    by apply mulr_ge0=>//; apply ltW.
 have [|uv0] := eqVneq ((u : R^o) <| t |> v) 0.
diff --git a/theories/convex.v b/theories/convex.v
index 0b1ed8a..206337d 100644
--- a/theories/convex.v
+++ b/theories/convex.v
@@ -233,7 +233,7 @@ split.
   (2*(Prob.p t : R) <= Rdefinitions.IZR (BinNums.Zpos 1%AC)).
       apply/andP; split.
         by apply mulr_ge0=>//.
-      by move:tle=>/(ler_wpmul2l ge20); rewrite divff.
+      by move:tle=>/(ler_wpM2l ge20); rewrite divff.
    move=>/esym xE.
    move: xext=>/(_ (u <| Prob.mk t01 |> v) v).
    rewrite -convA' convmm.
diff --git a/theories/counterclockwise.v b/theories/counterclockwise.v
index 581d0e0..461feb6 100644
--- a/theories/counterclockwise.v
+++ b/theories/counterclockwise.v
@@ -333,7 +333,7 @@ rewrite ltNge oppr_le0; apply /negP=>trp.
 suff: 0 < det t q r * det t s p + det t r p * det t s q + det t p q * det t s r.
   by rewrite convex_combination ltxx.
 rewrite addrC.
-apply ltr_paddr; [| by apply mulr_gt0].
+apply ltr_wpDr; [| by apply mulr_gt0].
 by apply addr_ge0; apply mulr_ge0=>//; apply ltW.
 Qed.
 
@@ -351,7 +351,7 @@ Proof.
 rewrite /ccw 3!det_scalar_productE/scalar_product/= !mulrN !subr_gt0 -![(pivot : R *l R) < _]subr_gtlex0 {1 2 3}/lt/=/ProdLexiOrder.lt/= !implybE -!ltNge !le_eqVlt ![(_==_)||_]orbC -!Bool.orb_andb_distrib_r=>/orP; case=>p0.
    move=>/orP; case=>q0.
       move=>/orP; case=>r0.
-         rewrite -(ltr_pdivr_mull _ _ p0) mulrA -(ltr_pdivl_mulr _ _ q0) [_^-1*_]mulrC -(ltr_pdivr_mull _ _ q0) mulrA -(ltr_pdivl_mulr _ _ r0) [_^-1*_]mulrC -(ltr_pdivr_mull _ _ p0) mulrA -(ltr_pdivl_mulr _ _ r0) [_^-1*_]mulrC=>qlt rlt; exact (lt_trans qlt rlt).
+         rewrite -(ltr_pdivrMl _ _ p0) mulrA -(ltr_pdivlMr _ _ q0) [_^-1*_]mulrC -(ltr_pdivrMl _ _ q0) mulrA -(ltr_pdivlMr _ _ r0) [_^-1*_]mulrC -(ltr_pdivrMl _ _ p0) mulrA -(ltr_pdivlMr _ _ r0) [_^-1*_]mulrC=>qlt rlt; exact (lt_trans qlt rlt).
       move:r0=>/andP[/eqP<- r0].
       by rewrite 2!mulr0 pmulr_rgt0// pmulr_rgt0//.
    move:q0=>/andP[/eqP<- q0]/orP; case.
diff --git a/theories/desc.v b/theories/desc.v
index 8c90999..9bb419c 100644
--- a/theories/desc.v
+++ b/theories/desc.v
@@ -649,7 +649,7 @@ Definition inv2 (p : {poly R}) :=
 
 (* initial definition said nothing on b *)
 Definition one_root1 (p : {poly R}) (a b : R) :=
-  exists c d k, 
+  exists c d k,
      [/\ [&& a < c, c < d, d < b & 0 < k],
      (pos_in_interval a c (horner p)),
      (neg_in_interval1 d b (horner p)) &
@@ -672,9 +672,9 @@ Proof.
 rewrite /slope_bounded; move =>x0 kf0 incf y z /andP [xy yz].
 rewrite -[z * _] (addrNK (z * f y)) -mulrBr -addrA -mulrBl mulrDl (mulrC (f y)).
 move: (le_trans xy yz) => xz.
-rewrite ler_add2r; apply: le_trans (_ : z * (k * (z - y)) <= _).
-  by rewrite - mulrA  ler_wpmul2r // mulr_ge0 // subr_ge0.
-by rewrite ler_wpmul2l ? incf ?xy ? yz//;apply:(le_trans x0). 
+rewrite lerD2r; apply: le_trans (_ : z * (k * (z - y)) <= _).
+  by rewrite - mulrA ler_wpM2r // mulr_ge0 // subr_ge0.
+by rewrite ler_wpM2l ? incf ?xy ? yz//;apply:(le_trans x0).
 Qed.
 
 (* Note that {poly R} is automatically converted into (seq R) *)
@@ -682,7 +682,7 @@ Qed.
 Lemma all_pos_positive (p : {poly R}) x:
   all_ge0 p -> 0 <= x -> p.[x] >= 0.
 Proof.
-move=> h x0; rewrite horner_coef. 
+move=> h x0; rewrite horner_coef.
 apply: sumr_ge0 => [] [i his _] /=.
 apply: mulr_ge0; rewrite ?exprn_ge0 //; apply: (allP h); exact: mem_nth.
 Qed.
@@ -693,8 +693,8 @@ Lemma all_pos_increasing (p : {poly R}):
 Proof.
 move=>  posp x y le0x le0y lexy; rewrite !horner_coef.
 apply: ler_sum => [] [i ihs] /= _.
-apply: ler_wpmul2l => //; first by apply: (allP posp); exact: mem_nth.
-by apply: ler_expn2r.
+apply: ler_wpM2l => //; first by apply: (allP posp); exact: mem_nth.
+by apply: lerXn2r.
 Qed.
 
 Lemma one_root1_uniq p a b: one_root1 p a b ->
@@ -773,14 +773,14 @@ Lemma one_root2_shift p a b:
 Proof.
 move=>  [ck [/andP [x1a kp] neg sl]].
 exists (a + ck.1,ck.2); split.
-    by rewrite  ltr_add2l x1a kp.
+    by rewrite ltrD2l x1a kp.
   move=> x /= abxax1; rewrite -(addrNK a x) - horner_shift_poly.
-  by rewrite neg // ltr_subr_addl ler_subl_addl.
+  by rewrite neg // ltrBrDl lerBlDl.
 move=> x y /= axy.
 have aux:  y - x = y - a - (x - a).
   by rewrite opprD addrAC -!addrA opprK addrN addr0.
 rewrite -{2} (addrNK a x)  -{2} (addrNK a y) -!(horner_shift_poly a _) aux.
-by apply: sl; rewrite ? ler_add2r // ler_subr_addr  addrC.
+by apply: sl; rewrite ?lerD2r // lerBrDr  addrC.
 Qed.
 
 Lemma one_root1_shift p a b c:
@@ -789,16 +789,16 @@ Lemma one_root1_shift p a b c:
 Proof.
 move=>  [x1 [x2 [k [/and4P [ax1 x1x2 x2b kp] pos neg sl]]]].
 exists (c + x1); exists (c + x2); exists k.
-rewrite ! ltr_add2l; split => //; first by apply /and4P.
+rewrite !ltrD2l; split => //; first by apply /and4P.
     move=> x cp; rewrite - (addrNK c x).
-    rewrite -horner_shift_poly pos ? ler_sub_addl  ? ltr_sub_addl //.
+    rewrite -horner_shift_poly pos ? lerBDl  ? ltrBDl //.
   move=> x cp; rewrite - (addrNK c x).
-  by rewrite -horner_shift_poly neg // ltr_subr_addl ltr_subl_addl.
+  by rewrite -horner_shift_poly neg // ltrBrDl ltrBlDl.
 move=> x y cx1x xy ycx2.
 have aux:  y - x = y - c - (x - c).
   by rewrite [x + _]addrC opprD opprK addrA addrNK.
 rewrite -{2} (addrNK c x)  -{2} (addrNK c y) aux -!(horner_shift_poly c _).
-by rewrite sl ? ler_add2r // ?ler_subr_addr? ler_subl_addr //  addrC.
+by rewrite sl ?lerD2r // ?lerBrDr? lerBlDr //  addrC.
 Qed.
 
 Lemma one_root1_scale p a b c:
@@ -808,20 +808,20 @@ Proof.
 move=> cp [x1 [x2 [k [/and4P [ax1 x1x2 x2b kp] pos neg sl]]]].
 exists (c * x1); exists (c * x2); exists (k / c).
 have tc : 0 < c^-1 by rewrite invr_gt0.
-rewrite !(ltr_pmul2l cp).
+rewrite !(ltr_pM2l cp).
 have t: forall z, z = c * (z / c).
   by move=> z; rewrite [c * _]mulrC mulfVK //;move: cp;rewrite lt0r => /andP [].
 split => //; first by apply/and4P; split => //; apply:mulr_gt0.
     move=> x cpp; rewrite (t x) - horner_scaleX_poly; apply: pos.
-    by rewrite ltr_pdivl_mulr // mulrC  ler_pdivr_mulr //(mulrC x1).
+    by rewrite ltr_pdivlMr // mulrC ler_pdivrMr //(mulrC x1).
   move=> x cpp.
   rewrite (t x) -horner_scaleX_poly neg //.
-  by rewrite ltr_pdivl_mulr // mulrC ltr_pdivr_mulr // (mulrC b).
+  by rewrite ltr_pdivlMr // mulrC ltr_pdivrMr // (mulrC b).
 move=> x y cx1x xy ycx2; rewrite -mulrA mulrDr mulrN ![c^-1 * _]mulrC
  {2}(t x) {2}(t y) -!(horner_scaleX_poly _ p); apply: sl.
-    by rewrite ler_pdivl_mulr // mulrC.
-  by rewrite ler_wpmul2r // ltW.
-by rewrite ler_pdivr_mulr // mulrC.
+    by rewrite ler_pdivlMr // mulrC.
+  by rewrite ler_wpM2r // ltW.
+by rewrite ler_pdivrMr // mulrC.
 Qed.
 
 End DescOnOrderedField.
@@ -851,7 +851,7 @@ move => haposp eps eps0; rewrite /inv2 /=.
     by rewrite -cons_poly_def polyseq_cons sp /= ltW.
   move/all_pos_inv/(_ eps eps0)=> [x [h1x h2x /andP[h3x h4x]]]; exists x.
   have xp:= ltW h3x.
-  split => //; rewrite h3x h4x !hornerE ltr_spaddr // mulr_ge0 //.
+  split => //; rewrite h3x h4x !hornerE ltr_pwDr // mulr_ge0 //.
   by rewrite all_pos_positive.
 (* case a < 0 *)
 rewrite -oppr_gt0 in ha.
@@ -866,10 +866,10 @@ rewrite -oppr_gt0 in ha.
   have qsincr: forall t d, x <= t -> 0 < d -> q.[t] < q.[t+d].
     move => t d xt dp; rewrite !hornerE.
     set w := _ + _.
-    have aux: t <= t+d by rewrite - {1}(addr0 t)  ler_add2l ltW.
+    have aux: t <= t+d by rewrite - {1}(addr0 t) lerD2l ltW.
     have xtd:= (le_trans xt aux).
-    rewrite  mulrDr -addrAC addrC ltr_spaddl ?(mulr_gt0 (ppos _ xtd) dp)//.
-    rewrite !ler_add2r (ler_pmul2r (lt_le_trans xp xt)).
+    rewrite  mulrDr -addrAC addrC ltr_pwDl ?(mulr_gt0 (ppos _ xtd) dp)//.
+    rewrite !lerD2r (ler_pM2r (lt_le_trans xp xt)).
     by apply:H2 => //.
   have qincr: forall t, x<=t -> {in <=%R t &, pol_increasing q}.
     move => t xt u v ut vt; rewrite le_eqVlt; case /orP => uv.
@@ -879,9 +879,9 @@ rewrite -oppr_gt0 in ha.
   move: (H2 _ _ (lexx x) yx' yx') => lepxpy.
   have yge0: 0 <= y by rewrite ltW // (lt_le_trans xp yx').
   have posval : 0 <= q.[y].
-    rewrite !hornerE -(addNr a) /= ler_add2r /=.
-    apply: (@le_trans _ _ (p.[x] * y)); last by rewrite ler_wpmul2r.
-    rewrite  // mulrC - ler_pdivr_mulr // ltW //.
+    rewrite !hornerE -(addNr a) /= lerD2r /=.
+    apply: (@le_trans _ _ (p.[x] * y)); last by rewrite ler_wpM2r.
+    rewrite  // mulrC - ler_pdivrMr // ltW //.
   set r := ('X * q).
   have negval' : r.[x] < 0 by rewrite 2!hornerE pmulr_rlt0.
   have posval' : 0 <= r.[y] by rewrite 2! hornerE mulr_ge0.
@@ -892,36 +892,36 @@ rewrite -oppr_gt0 in ha.
   move /and5P => [/and3P [_ _ smallv] /and3P[xd dv v'y] _ posv _].
   have {xd dv} xv : x < v  by apply: le_lt_trans xd dv.
   have pv : 0 < v by apply: lt_trans xv.
-  move: posv; rewrite  2! hornerE -{1} (mulr0 v) (ler_pmul2l  pv) => posv.
+  move: posv; rewrite  2! hornerE -{1} (mulr0 v) (ler_pM2l  pv) => posv.
   move: (pol_cont r v he1) => [d' dp' pd'].
   pose d := half d'.
   have dp : d > 0  by rewrite  half_gt0.
   have dd' : d < d' by apply: half_ltx.
-  have vvd : v < v + d by rewrite ltr_addl /=.
+  have vvd : v < v + d by rewrite ltrDl /=.
   have xvd : x < v + d by apply: lt_trans vvd.
   have lvd : 0 < p.[v + d] by apply: ppos; exact: ltW.
   move => {y yx val yx' posval posval' v'y lepxpy yge0}.
   have pa: le_below_x (v + d) (horner q).
-    move => y y0 yvd; rewrite !hornerE ler_add2r /=.
+    move => y y0 yvd; rewrite !hornerE lerD2r /=.
     case cmp: (y <= x); last first.
       have cmp': x <= y by rewrite ltW // ltNge cmp.
       apply: le_trans (_ : p.[v + d] * y <= _).
-       by apply: ler_wpmul2r => //; apply: H2 => //;apply: (le_trans cmp').
-       by rewrite ler_wpmul2l // ltW.
+       by apply: ler_wpM2r => //; apply: H2 => //;apply: (le_trans cmp').
+       by rewrite ler_wpM2l // ltW.
     apply: le_trans (_ : p.[x] * y <= _).
-      by rewrite ler_wpmul2r //; apply: H1.
+      by rewrite ler_wpM2r //; apply: H1.
     apply: le_trans (_ : p.[x] * (v + d) <= _); last first.
-      rewrite ler_wpmul2r //; first exact: le_trans yvd.
+      rewrite ler_wpM2r //; first exact: le_trans yvd.
       rewrite H2 //; first (by apply: (lexx x)); by  apply:ltW.
-    by rewrite ler_wpmul2l // ltW.
+    by rewrite ler_wpM2l // ltW.
   exists (v + d).
   rewrite (le_lt_trans posv (qsincr _ _ (ltW xv) dp)) (lt_trans pv vvd).
   split => //=; first by apply: qincr; apply: ltW.
   rewrite - (double_half epsilon).
   apply: le_trans (_ : ((half epsilon) + r.[v+d] -r.[v]) <= _).
     rewrite  [ half epsilon + _] addrC -addrA.
-    rewrite [r.[v + d]] hornerE hornerX ler_addl subr_ge0 //.
-  rewrite -! addrA ler_add2l.
+    rewrite [r.[v + d]] hornerE hornerX lerDl subr_ge0 //.
+  rewrite -!addrA lerD2l.
   have aux:`|(v+d) - v| < d' by rewrite (addrC v) addrK ger0_norm// ltW.
   by move: (ltW (pd' _ aux)) => /ler_normlP [_].
 (* case a = 0 *)
@@ -934,7 +934,7 @@ have aux: forall w, 0 <=w -> 0 <= p.[w] -> {in <=%R w &, pol_increasing p} ->
    {in <=%R w &, pol_increasing ((p * 'X))}.
   move => w wz pwz H s t sw tw st; rewrite !hornerE.
   move: (H _ _ sw tw st) (le_trans pwz (H _ _ (lexx w) sw sw)) => pa pb.
-    by apply:(ler_pmul pb (le_trans wz sw) pa st).
+    by apply:(ler_pM pb (le_trans wz sw) pa st).
 set w:= (Num.min x v); exists w.
 have wc: w = x \/ w = v.
   by rewrite /w /minr; case: ifPn; [left|right].
@@ -946,17 +946,17 @@ split.
     apply: (pmul2w1 tp (ltW pw0) tw).
     move: tp tw;case wc=> ->; [apply: plx | apply: plv].
   by apply: aux; [apply: ltW | by apply: ltW| case wc => ->].
-move: lpve; rewrite  (ler_pdivl_mulr _ _ gx0) => lpve.
+move: lpve; rewrite  (ler_pdivlMr _ _ gx0) => lpve.
 case /orP:(le_total x v)=> xv;
   rewrite /w/=.
   move/min_idPr : (xv); rewrite minC => ->.
    apply: le_trans lpve; rewrite mulrA.
-   rewrite (ler_pmul2r gx0);apply: (ler_pmul (ltW gx0) (ltW gpx0) xv).
+   rewrite (ler_pM2r gx0);apply: (ler_pM (ltW gx0) (ltW gpx0) xv).
   exact:(pmonx _ _ (lexx x) xv xv).
 move/min_idPr : (xv) => ->.
 apply: le_trans lpve.
 rewrite mulrA.
-by rewrite (ler_pmul2l (mulr_gt0 gv0 gpv0) v x).
+by rewrite (ler_pM2l (mulr_gt0 gv0 gpv0) v x).
 Qed.
 
 Lemma desc  (p: {poly R}): alternate p -> one_root2 p 0.
@@ -982,7 +982,7 @@ case: (ltrP a 0) => ha alt1.
   move:(slope_product_x (ltW xp) (lexx 0) slp xyz).
   move/andP :xyz => [xy yz].
   rewrite mulr0 add0r; apply: le_trans.
-  by apply: (ler_wpmul2r _ (pmon _ _ (lexx x) xy xy)); rewrite subr_ge0.
+  by apply: (ler_wpM2r _ (pmon _ _ (lexx x) xy xy)); rewrite subr_ge0.
 move: alt1; case a0 : (a == 0) => // alt1; move: (eqP a0) => a00.
 clear ha a0.
 move: (IHl alt1) => [v1k []] {IHl}.
@@ -993,8 +993,8 @@ have posk' : 0 < k' by apply: half_gt0; apply: mulr_gt0.
 set u := (- p.[v1]) / k.
 move: (maxS 0 u); set v:=  Num.max 0 _ => /andP [pa pb].
 set v2:= v1 + v +1.
-have v0: 0 <= v by rewrite le_maxr lexx.
-have v1v2: v1 < v2 by rewrite /v2 - addrA (ltr_addl v1).
+have v0: 0 <= v by rewrite le_max lexx.
+have v1v2: v1 < v2 by rewrite /v2 - addrA (ltrDl v1).
 have pos1:0 <= p.[v1 + v].
   move: (kpos); rewrite lt0r => /andP [ kne0 _].
   move: kpos; rewrite - invr_gt0 => kpos.
@@ -1002,11 +1002,11 @@ have pos1:0 <= p.[v1 + v].
     by rewrite  addr0 - oppr_le0 - (pmulr_lle0 _ kpos).
   case/orP:(le_total u 0); [ | move => up].
     by rewrite leNgt caf.
-  have aa: v1 <= v1 <= v1 + u  by rewrite lexx  ler_addl.
-  rewrite - (ler_addr (- p.[v1]));apply: le_trans (incr _ _ aa).
+  have aa: v1 <= v1 <= v1 + u  by rewrite lexx  lerDl.
+  rewrite -(lerDr (- p.[v1]));apply: le_trans (incr _ _ aa).
   by rewrite  (addrC v1) addrK /u (mulrC _ (k^-1)) mulVKf //.
 have pos : 0 < p.[v2].
-  have hh: v1 <= v1 + v <= v1 + v + 1 by rewrite !ler_addl v0 ler01.
+  have hh: v1 <= v1 + v <= v1 + v + 1 by rewrite !lerDl v0 ler01.
   apply: (le_lt_trans pos1);rewrite -subr_gt0.
   by apply: (lt_le_trans _ (incr _ _ hh)); rewrite addrAC addrN add0r mulr1.
 clear v0 pos1 pa pb.
@@ -1030,8 +1030,8 @@ rewrite ! horner_cons a00 !addr0 (mulrC _ x)  (mulrC _ y).
 have: (v1 * k + p.[x]) * (y - x) <= y * p.[y] - x * p.[x].
   apply:(slope_product_x (ltW v1pos) (ltW kpos) incr).
   by rewrite xy (le_trans v1x1 x1x).
-apply: le_trans; rewrite ler_wpmul2r //; first by rewrite subr_ge0.
-rewrite mulrC - (double_half (k * v1 )) -/k' - addrA ler_addl.
+apply: le_trans; rewrite ler_wpM2r //; first by rewrite subr_ge0.
+rewrite mulrC - (double_half (k * v1 )) -/k' - addrA lerDl.
 rewrite - (opprK k') addrC subr_gte0 (le_trans x1close) // -subr_gte0.
 have: k * (x - x1) <= p.[x] - p.[x1]  by apply: incr =>//; rewrite x1x v1x1.
 by apply : le_trans; apply: mulr_ge0 => //; rewrite ?(ltW kpos) ?subr_ge0.
@@ -1049,21 +1049,21 @@ have x10 : 0 < x1 by apply: lt_trans x1gt1; exact: ltr01.
 set y' := x1 - q.[x1] / k.
 have nx1 : q.[x1] < 0 by rewrite neg //x1gt1 lexx.
 have knz: k != 0 by move: kp; rewrite lt0r; case /andP =>[].
-have y'1: x1 < y' by rewrite /y' ltr_addl oppr_gt0 pmulr_llt0 // ?invr_gt0.
+have y'1: x1 < y' by rewrite /y' ltrDl oppr_gt0 pmulr_llt0 // ?invr_gt0.
 have y'pos : 0 <= q.[y'].
   have aux: x1 <= x1 <= y' by rewrite (lexx x1) (ltW y'1).
-  rewrite - (ler_add2r (- q.[x1])) add0r; apply: le_trans (sl _ _ aux).
+  rewrite -(lerD2r (- q.[x1])) add0r; apply: le_trans (sl _ _ aux).
   by rewrite /y' (addrC x1) addrK mulrN mulrC mulfVK.
 move: (@diff_xn_ub R deg 1); set u := _ *+ _; move => up.
 set u':= Num.max 1 u.
-have uu': u <= u' by rewrite le_maxr lexx orbT.
-have u1: 1 <= u' by rewrite le_maxr lexx.
+have uu': u <= u' by rewrite le_max lexx orbT.
+have u1: 1 <= u' by rewrite le_max lexx.
 have u'0 : 0 < u' by rewrite (lt_le_trans ltr01).
 have divu_ltr : forall x, 0 <= x -> x / u' <= x.
-   move => x x0; rewrite ler_pdivr_mulr // ler_pemulr //.
+   move => x x0; rewrite ler_pdivrMr // ler_peMr //.
 have y'0: 0 < y' by apply: lt_trans y'1.
 pose y := y' + 1.
-have y'y : y' < y by rewrite /y ltr_addl.
+have y'y : y' < y by rewrite /y ltrDl.
 have y1 : x1 < y by apply: lt_trans y'1 _.
 have ypos : 0 <  q.[y].
   have aux: x1 <= y' <= y by rewrite (ltW y'1) (ltW y'y).
@@ -1091,13 +1091,13 @@ have cp0 : 0 < c.
   move: (cp _ _ pa (ltW ab) pb); rewrite (gtr0_norm dp) => dp'.
   by move: (lt_le_trans  dp dp'); rewrite pmulr_lgt0 // subr_gt0.
 set b := Num.min y (b' +(half e1)/c).
-have blty: b <= y by  rewrite /b le_minl lexx.
+have blty: b <= y by  rewrite /b ge_min lexx.
 have b'b: b' < b.
-  rewrite lt_minr (le_lt_trans b'y' y'y) /= - ltr_subl_addl addrN.
+  rewrite lt_minr (le_lt_trans b'y' y'y) /= - ltrBlDl addrN.
   by rewrite (divr_gt0 (half_gt0 e1p) cp0).
 have clb:c * (b - b') < e1.
   apply: le_lt_trans (half_ltx e1p).
-  by rewrite -  (ler_pdivl_mull _ _ cp0) mulrC ler_subl_addl le_minl lexx orbT.
+  by rewrite -(ler_pdivlMl _ _ cp0) mulrC lerBlDl ge_min lexx orbT.
 pose n := (size p).-1.
 have a0 : 0 < a by apply: lt_le_trans x1a.
 have b'0 : 0 < b' by apply: lt_trans ab.
@@ -1116,7 +1116,7 @@ have res1:pos_in_interval 0 b^-1 (horner p).
   rewrite -[x]invrK -sgr_cp0 - inv_mono  ?invr_gt0 // sgr_cp0.
   rewrite (le_lt_trans posb') //  -subr_gte0 /=.
   have b'x : b' < x^-1.
-    by rewrite inv_comp// (le_lt_trans xb)// ltf_pinv.
+    by rewrite inv_comp// (le_lt_trans xb)// ltf_pV2.
   have aa:x1 <= b' <= x^-1 by rewrite (ltW (le_lt_trans x1a ab)) (ltW b'x).
   by apply:lt_le_trans (sl _ _ aa); rewrite  mulr_gt0 // subr_gt0.
 have res2: neg_in_interval1 a^-1 1 (horner p).
@@ -1134,7 +1134,7 @@ have res2: neg_in_interval1 a^-1 1 (horner p).
   by rewrite mulr_gt0 // subr_gt0.
 exists b^-1, a^-1, k'.
 split => //.
-  rewrite k'p ibp ltf_pinv// (inv_compr ltr01 a0) invr1.
+  rewrite k'p ibp ltf_pV2// (inv_compr ltr01 a0) invr1.
   by rewrite (lt_trans ab b'b) (lt_le_trans x1gt1 x1a).
 move => x z bvx xz zav.
   rewrite le_eqVlt in xz; move/orP: xz => [xz | xz].
@@ -1167,7 +1167,7 @@ set t2 := t3 * _.
 pose k1 := -k'; pose k2 := k' + k'.
 have k2p : k2 = (k * x1 ^+ 2 * y ^-1 ^+ s) by apply: double_half.
 rewrite (_ : k' = k1 + k2); last by rewrite /k1 /k2 addrA addNr add0r.
-have xzi: z^-1 < x^-1 by rewrite ltf_pinv.
+have xzi: z^-1 < x^-1 by rewrite ltf_pV2.
 have pa : x1 <=  z^-1.
   by rewrite (le_trans x1a)// -(invrK a)// lef_pinv// posrE invr_gt0.
 have pb: x1 <=  x^-1 by rewrite (ltW (le_lt_trans pa xzi)).
@@ -1178,21 +1178,21 @@ have t3p:=  le_trans pc pd.
 have pe : 0 <= y^-1 <= z.
   by rewrite invr_ge0 ltW //= (le_trans _ (ltW xz))// (le_trans _ bvx)// lef_pinv.
 case /andP: (pow_monotone s pe) => _ hh.
-have maj' : t3 * y^-1 ^+ s <= t3 * z^+ s by rewrite ler_wpmul2l.
-rewrite mulrDl; apply: ler_add; last first.
+have maj' : t3 * y^-1 ^+ s <= t3 * z^+ s by rewrite ler_wpM2l.
+rewrite mulrDl; apply: lerD; last first.
   apply: le_trans maj'; rewrite /t3 k2p mulrAC.
-  rewrite ler_pmul2r; last by apply: exprn_gt0; rewrite invr_gt0.
+  rewrite ler_pM2r; last by apply: exprn_gt0; rewrite invr_gt0.
   apply: le_trans pd.
-  rewrite ![k * _]mulrC mulrAC ler_pmul2r //.
+  rewrite ![k * _]mulrC mulrAC ler_pM2r //.
   have xn0 : (x != 0) by move: x0; rewrite lt0r; case /andP =>[].
   have zn0 : (z != 0) by move: z0; rewrite lt0r; case /andP =>[].
   have xVn0 : (x^-1 != 0) by move: x0; rewrite -invr_gt0 lt0r; case /andP =>[].
   rewrite -[x^-1](mulfK zn0)  -(mulrC z) - (mulrA z _ _).
   rewrite -{2}[z^-1](mulfK xn0) -(mulrA _  x _)(mulrCA _ x).
   rewrite (mulrC z^-1)  -mulrBl (mulrC (z - x)).
-  rewrite ler_pmul2r /=; last by rewrite subr_gte0.
-  apply: le_trans (_ : x1 / z <= _); first rewrite ler_pmul2l //=.
-  by rewrite ler_pmul2r ?invr_gt0.
+  rewrite ler_pM2r /=; last by rewrite subr_gte0.
+  apply: le_trans (_ : x1 / z <= _); first rewrite ler_pM2l //=.
+  by rewrite ler_pM2r ?invr_gt0.
 move:(ltW xz) => xz'.
 have xzexp : (x ^+ s - z ^+ s) <= 0.
    have aux: 0 <=x <= z by rewrite xz' ltW//.
@@ -1211,23 +1211,23 @@ have rpxe : q.[x^-1] <= e.
     rewrite -subr_ge0 /= ;apply: le_trans (sl _ _ aux).
     rewrite mulr_ge0  ?subr_gte0 // ltW //.
   rewrite -[_ _ b]addr0 -(addrN (q).[b']) addrA.
-  rewrite (addrC ( _ b)) -addrA - (double_half e) (ler_add clb')//.
+  rewrite (addrC ( _ b)) -addrA -(double_half e) (lerD clb')//.
   have yb: - y <= b' by apply: ltW; apply: lt_trans b'0; rewrite oppr_lt0.
   move: (le_trans (cp b' b yb (ltW b'b) blty) (ltW clb)).
   by move /ler_normlP => [_].
 apply: le_trans (_ : (z^+ s - x ^+ s) * e <= _).
-  by rewrite ler_wpmul2l // ?subr_gte0.
+  by rewrite ler_wpM2l // ?subr_gte0.
 have un0 : (u' != 0) by  move: u'0; rewrite lt0r; case /andP =>[].
 rewrite [_ * e]mulrC; apply: le_trans (_ : e * (u' * (z - x)) <= _)=> /=.
-  apply: ler_wpmul2l; first exact: ltW.
+  apply: ler_wpM2l; first exact: ltW.
   apply: (@le_trans _ _ (u * (z - x))).
     have xm1: -1 <= x by exact: (ltW (lt_trans (ltrN10 R) x0)).
     have a1 : 1 <= a by apply: (ltW (lt_le_trans x1gt1 x1a)).
     rewrite - (ger0_norm xzexp'); apply: (up _ _ xm1 xz').
     apply: le_trans zav _.
     by rewrite invr_le1 // unitf_gt0.
-  by rewrite ler_pmul2r // subr_gte0.
-rewrite mulrA ler_pmul2r; last by rewrite subr_gte0.
+  by rewrite ler_pM2r // subr_gte0.
+rewrite mulrA ler_pM2r; last by rewrite subr_gte0.
 rewrite /= /e  divfK ?lterr //.
 Qed.
 
diff --git a/theories/door_crossing.v b/theories/door_crossing.v
index 984dd99..7067e18 100644
--- a/theories/door_crossing.v
+++ b/theories/door_crossing.v
@@ -1,5 +1,5 @@
 From HB Require Import structures.
-From mathcomp Require Import all_ssreflect all_algebra all_real_closed reals.
+From mathcomp Require Import all_ssreflect all_algebra all_real_closed archimedean reals.
 From mathcomp.algebra_tactics Require Import ring lra.
 Require Import casteljau convex counterclockwise intersection.
 
@@ -14,7 +14,7 @@ Local Open Scope ring_scope.
 
 Section sandbox.
 
-Lemma poly_coord {R : rcfType} 
+Lemma poly_coord {R : rcfType}
   (c : (R^o * R^o)%type)
   (p : {poly R}) (t : R) :
   p.[t] *: c = c.1 * p.[t] *: (1, 0) + c.2 * p.[t] *: (0, 1).
@@ -22,7 +22,6 @@ Proof.
 congr (_, _); rewrite /= !scaler0 ?addr0 ?add0r mulrC /GRing.scale /=; ring.
 Qed.
 
-  
 Variable R : reals.Real.type.
 
 (* This version differs from the one in the hulls development to avoid
@@ -48,7 +47,7 @@ Proof. by rewrite /= /conv addrC. Qed.
   bezier c 2 t =  (bernp 0 1 2 0) *: c 0%N. *)
 
 Lemma bezier_bernstein2 c t :
-  bezier c 2 t = 
+  bezier c 2 t =
     \sum_(i < 3) (bernp 0 1 2 i).[t] *: c i.
 Proof.
 rewrite !big_ord_recr big_ord0 /= add0r.
@@ -88,9 +87,9 @@ rewrite -!addrA -!scalerDl.
 congr (_ *: _ + _ *: _); ring.
 Qed.
 
-Record edge := Bedge 
+Record edge := Bedge
   { left_pt : Plane R;
-    right_pt : Plane R; 
+    right_pt : Plane R;
     edge_cond : left_pt.1 < right_pt.1}.
 
 Record cell :=
@@ -178,12 +177,12 @@ end.
 
 Definition cell_safe_exits_left (c : cell) : seq vert_edge :=
   let lx := (seq.head dummy_pt (left_pts c)).1 in
-  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2) 
+  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2)
    (seq_to_intervals (left_pts c)).
 
 Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   let lx := (seq.head dummy_pt (right_pts c)).1 in
-  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2) 
+  map (fun p => Build_vert_edge lx (p.1).2 (p.2).2)
    (seq_to_intervals (rev (right_pts c))).
 
 Definition dummy_vert_edge :=
@@ -193,7 +192,7 @@ Definition on_vert_edge (p : Plane R) (v : vert_edge) : bool :=
   (p.1 == ve_x v) && (ve_bot v < p.2 < ve_top v).
 
 Check fun (v : vert_edge) (l : seq vert_edge) => v \in l.
-Check fun (v : vert_edge)(c : cell) => 
+Check fun (v : vert_edge)(c : cell) =>
    v \in cell_safe_exits_left c.
 
 Lemma detDM2 (l p1 p2 q1 q2 r1 r2 : R) :
@@ -287,7 +286,7 @@ have vxright : ve_x v = right_limit c.
   elim/last_ind: (right_pts c) rightn0 samexr => [ // | lh e1 Ih] _ /=.
   elim/last_ind: lh Ih => [ // | lh e2 _] Ih samexr.
   rewrite last_rcons !rev_rcons/=.
-  rewrite inE=> /orP[/eqP -> /= | vin]. 
+  rewrite inE=> /orP[/eqP -> /= | vin].
     by rewrite (eqP (samexr e1 _)) // mem_rcons inE eqxx.
   rewrite (eqP (samexr e1 _)); last by rewrite mem_rcons inE eqxx.
   rewrite -(eqP (samexr e2 _)); last by rewrite !(mem_rcons, inE) eqxx ?orbT.
@@ -398,7 +397,7 @@ have vxright : ve_x v = right_limit c.
   elim/last_ind: (right_pts c) rightn0 samexr => [ // | lh e1 Ih] _ /=.
   elim/last_ind: lh Ih => [ // | lh e2 _] Ih samexr.
   rewrite last_rcons !rev_rcons/=.
-  rewrite inE=> /orP[/eqP -> /= | vin]. 
+  rewrite inE=> /orP[/eqP -> /= | vin].
     by rewrite (eqP (samexr e1 _)) // mem_rcons inE eqxx.
   rewrite (eqP (samexr e1 _)); last by rewrite mem_rcons inE eqxx.
   rewrite -(eqP (samexr e2 _)); last by rewrite !(mem_rcons, inE) eqxx ?orbT.
@@ -448,8 +447,8 @@ have -> : head dummy_pt (rcons l e2) = head dummy_pt (rcons (rcons l e2) e1).
   by case lq : l.
 by rewrite rev_rcons 2!headI /=.
 Qed.
-  
-Lemma vert_projr (p q r : Plane R) : 
+
+Lemma vert_projr (p q r : Plane R) :
   p.1 != q.1 -> (det p q r == 0) =
   (r.2 == q.2 + (r.1 - q.1) / (q.1 - p.1) * (q.2 - p.2)).
 Proof.
@@ -467,7 +466,7 @@ rewrite invrN !(mulrN, mulNr).
 rewrite mulfVK //; ring.
 Qed.
 
-Lemma vert_projl (p q r : Plane R) : 
+Lemma vert_projl (p q r : Plane R) :
   p.1 != q.1 -> (det p q r == 0) =
   (r.2 == p.2 + (r.1 - p.1) / (q.1 - p.1) * (q.2 - p.2)).
 Proof.
@@ -499,9 +498,9 @@ move: (cok)=> /andP[] leftn0 /andP[] samexl /andP[] sortl /andP[] lonh _.
 rewrite /point_strictly_under_edge.
 set l := ((right_pt (high c)).1 - p.1) /
             ((right_pt (high c)).1 - (left_pt (high c)).1).
-set q := ((right_pt (high c)).1 - l * 
+set q := ((right_pt (high c)).1 - l *
              ((right_pt (high c)).1 - (left_pt (high c)).1),
-        (right_pt (high c)).1 - l * 
+        (right_pt (high c)).1 - l *
            ((right_pt (high c)).2 - (left_pt (high c)).2)).
 case pq : p => [p1 p2].
 case lq : (left_pt (high c)) => [q1 q2].
@@ -762,7 +761,7 @@ have [P1 | P2] := ltrP t u.
   have t'int : 0 <= t' < 1.
     apply/andP; split.
       rewrite /t'; apply divr_ge0; lra.
-    rewrite /t' ltr_pdivr_mulr; lra.
+    rewrite /t' ltr_pdivrMr; lra.
   have tt' : t = t' * u by rewrite /t' mulfVK.
   have := bezier2_dichotomy_l (f3pt p1 p2 p3) t' u; rewrite -tt' /bzt => ->.
   set p2' := p2 <| u |> p1.
@@ -777,7 +776,7 @@ have [P1 | P2] := ltrP t u.
     have sgp1 : sgz (det p1 (left_pt (high c1)) (right_pt (high c1))) = -1.
       by apply:ltr0_sgz; move: p1in=> /andP[] /andP[].
     have sgp2' : sgz
-             ((det p2 (left_pt (high c1)) (right_pt (high c1)) : R ^o) <|u|> 
+             ((det p2 (left_pt (high c1)) (right_pt (high c1)) : R ^o) <|u|>
              det p1 (left_pt (high c1)) (right_pt (high c1))) = -1.
       apply: conv_num_sg=> //.
       apply: ltr0_sgz; exact p2belh1.
@@ -792,7 +791,7 @@ have [P1 | P2] := ltrP t u.
     have sgp1 : sgz (det p1 (left_pt (low c1)) (right_pt (low c1))) = 1.
        by apply:gtr0_sgz; move: p1in=> /andP[] /andP[] _; rewrite -ltNge.
     have sgp2' : sgz
-             ((det p2 (left_pt (low c1)) (right_pt (low c1)) : R ^o) <|u|> 
+             ((det p2 (left_pt (low c1)) (right_pt (low c1)) : R ^o) <|u|>
              det p1 (left_pt (low c1)) (right_pt (low c1))) = 1.
       apply: conv_num_sg=> //.
       apply: gtr0_sgz; rewrite ltNge; exact p2abol1.
@@ -837,7 +836,7 @@ have [t1 | tn1] := eqVneq t 1.
 have t'int : 0 < t' < 1.
   rewrite /t'; apply/andP; split.
     apply: divr_gt0; lra.
-  by rewrite ltr_pdivr_mulr; lra.
+  by rewrite ltr_pdivrMr; lra.
 set p1' := bezier (f3pt p1 p2 p3) 2 u.
 set p2' := p3 <| u |> p2.
 rewrite [bezier _ 2 _](_ : _ = (p3 <| t' |> p2') <| t' |> (p2' <| t' |> p1'));
@@ -848,7 +847,7 @@ rewrite /point_strictly_under_edge !det_conv.
   have sgp3 : sgz (det p3 (left_pt (high c2)) (right_pt (high c2))) = -1.
     by apply:ltr0_sgz; move: p3in=> /andP[] /andP[].
   have sgp2' : sgz
-           ((det p3 (left_pt (high c2)) (right_pt (high c2)) : R ^o) <|u|> 
+           ((det p3 (left_pt (high c2)) (right_pt (high c2)) : R ^o) <|u|>
              det p2 (left_pt (high c2)) (right_pt (high c2))) = -1.
     apply: conv_num_sg=> //.
     apply: ltr0_sgz; exact p2belh2.
@@ -863,7 +862,7 @@ apply/andP; split.
   have sgp3 : sgz (det p3 (left_pt (low c2)) (right_pt (low c2))) = 1.
      by apply: gtr0_sgz; move: p3in=> /andP[] /andP[] _; rewrite -ltNge.
   have sgp2' : sgz
-             ((det p3 (left_pt (low c2)) (right_pt (low c2)) : R ^o) <|u|> 
+             ((det p3 (left_pt (low c2)) (right_pt (low c2)) : R ^o) <|u|>
              det p2 (left_pt (low c2)) (right_pt (low c2))) = 1.
     apply: conv_num_sg=> //.
     by apply: gtr0_sgz; rewrite ltNge; exact p2abol2.
@@ -905,7 +904,7 @@ Qed.
 
 Definition midpoint (a b : Plane R) := a <| 1/2 |> b.
 
-Definition mkedge_aux (a b : Plane R) : {e : edge | 
+Definition mkedge_aux (a b : Plane R) : {e : edge |
      forall h : a.1 < b.1, e = Bedge h}.
 case (boolP (a.1 < b.1)).
 move=> h; exists (Bedge h)=> h0.
@@ -924,7 +923,7 @@ rewrite /mkedge; case: (mkedge_aux a b)=> v Pv /=; apply: Pv.
 Qed.
 
 Fixpoint check_bezier_ccw (fuel : nat) (v : vert_edge)
-  (a b c : Plane R) : 
+  (a b c : Plane R) :
   option bool :=
 match fuel with
 | O => None
@@ -935,7 +934,7 @@ match fuel with
   else if
      point_under_edge top_edge (mkedge a b) ||
      point_under_edge top_edge (mkedge b c)
-  then 
+  then
     Some false
   else
     let b' := midpoint a b in
@@ -1004,7 +1003,7 @@ rewrite det_scalar_productE /rotate /scalar_product /= mulrN.
 by rewrite mulrC; congr (_ - _); rewrite mulrC.
 Qed.
 
-Lemma height_bezier2 (a b c p : Plane R) t: 
+Lemma height_bezier2 (a b c p : Plane R) t:
   a.1 < b.1 < c.1 ->
   (* p is the vertical projection of bezier ... t on the straight line ab *)
   det a b p = 0 ->
@@ -1035,7 +1034,7 @@ rewrite !tmp tmp1 /=.
 ring.
 Qed.
 
-Lemma safe_bezier_ccw_corner_side (a b c : Plane R) (v : vert_edge) 
+Lemma safe_bezier_ccw_corner_side (a b c : Plane R) (v : vert_edge)
   (u : R):
   ccw a b c ->
   a.1 < b.1 < c.1 ->
@@ -1075,8 +1074,8 @@ set p' := (p.1, (left_pt e).2 + (p.1 - (left_pt e).1) /
 have := diff_vert_y ecnd'=> /(_ p p' erefl) /eqP.
 rewrite subr_eq=> /eqP ->; rewrite /p' /=.
 rewrite addrA (addrC _ (left_pt e).2) -!addrA.
-rewrite ler_add2.
-rewrite addrC -ler_subr_addl mulrAC addrN.
+rewrite lerD2.
+rewrite addrC -lerBrDl mulrAC addrN.
 rewrite pmulr_lle0 // invr_gt0/=.
 by rewrite subr_gt0.
 Qed.
diff --git a/theories/isolate.v b/theories/isolate.v
index b908beb..6d725f1 100644
--- a/theories/isolate.v
+++ b/theories/isolate.v
@@ -169,9 +169,9 @@ have twon0 : (1 + 1 != 0 :> R').
 have twoV : forall a, a = a/(1 + 1) + a/(1+1) :> R'.
   by move=> y; rewrite -mulrDl -(mulr1 y) -mulrDr mulrK // mulr1.
 have altm : a < (a + b)/(1 + 1).
- by rewrite {1}[a]twoV mulrDl ltr_add2l ltr_pmul2r // invr_gt0.
+ by rewrite {1}[a]twoV mulrDl ltr_add2l ltr_pM2r // invr_gt0.
 have mltb : (a + b)/(1 + 1) < b.
- by rewrite {2}[b]twoV mulrDl ltr_add2r ltr_pmul2r // invr_gt0.
+ by rewrite {2}[b]twoV mulrDl ltr_add2r ltr_pM2r // invr_gt0.
 have mna : (a + b)/(1 + 1) != a.
  by apply/negP => ma; move:altm; rewrite ltr_neqAle eq_sym ma.
 have mnb : (a + b)/(1 + 1) != b.
@@ -354,11 +354,11 @@ have rbman0 : ratr b - ratr a != 0 :> RealAlg.alg_of_rcfType R.
  by rewrite subr_eq0 eq_sym.
 have twogt0 : 0 < 1 + 1 :> rat   by apply: addr_gt0; rewrite ltr01 .
 have a1b1 : (a + b)/(1+1) < b :> rat.
- rewrite -(ltr_pmul2r twogt0) mulfVK.
+ rewrite -(ltr_pM2r twogt0) mulfVK.
   by rewrite mulrDr mulr1 ltr_add2r.
  by move: twogt0; rewrite ltr_neqAle eq_sym=>/andP; case.
 have a2b2 : a < (a + b)/(1+1) :> rat.
- rewrite -(ltr_pmul2r twogt0) mulfVK.
+ rewrite -(ltr_pM2r twogt0) mulfVK.
   by rewrite mulrDr mulr1 ltr_add2l.
  by move: twogt0; rewrite ltr_neqAle eq_sym=>/andP; case.
 have rmbd: (ratr a + ratr b)/(1+1) != ratr b :> RealAlg.alg_of_rcfType R.
diff --git a/theories/opening_cells.v b/theories/opening_cells.v
index 2dfde42..9064180 100644
--- a/theories/opening_cells.v
+++ b/theories/opening_cells.v
@@ -833,22 +833,22 @@ rewrite /= pvertE //.
 have : {subset ogs <= outgoing e} by move=> x xin; rewrite -elems inE xin orbT.
 move: (fog) lf vf {ogeq elems}.
 elim : (ogs) le {vle} => [ | f q Ih] //= => le fog1 lfog1 vf1 qsubo.
-  rewrite 
+  rewrite
    -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
-  rewrite 
+  rewrite
     -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
-  rewrite pvertE // pvertE //=. 
+  rewrite pvertE // pvertE //=.
   rewrite -[pt_eqb _ _ _ (point e)]/(_ == point e :> pt).
   rewrite (negbTE pdif).
   have -> : pvert_y (point e) fog1 = p_y (point e).
      by apply on_pvert; rewrite -lfog1 left_on_edge.
   rewrite -[pt_eqb _ _ (point e) _]/(point e == _ :> pt).
-  rewrite pt_eqE /= !eqxx /=; congr (_ :: _ :: _); apply/(@eqP [eqType of pt]).
+  rewrite pt_eqE /= !eqxx /=; congr (_ :: _ :: _); apply/(@eqP pt).
   by rewrite pt_eqE /= !eqxx.
 case oca_eq: (opening_cells_aux _ _ _ _) => [s c].
-rewrite 
+rewrite
  -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
 rewrite pvertE //=.
@@ -906,22 +906,22 @@ have {outp} : {in sort (@edge_below _) s, forall g, left_pt g == p'}.
   by move=> g; rewrite mem_sort; apply: outp.
 elim: (sort _ _) le => [ | g gs Ih] le.
   move=> _ /= vle g.
-  rewrite 
+  rewrite
    -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
-  rewrite 
+  rewrite
    -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
   rewrite (pvertE vle) (pvertE vhe) !inE => /eqP ->.
   do 2 rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
   case: ifP=> []; case: ifP=> [] /=.
         move=> /eqP -> // /eqP <-.
-        by rewrite (@mem_head [eqType of pt]).
-      by rewrite (@mem_head [eqType of pt]).
-    move=> /eqP <-; rewrite (@in_cons [eqType of pt]).
-    by rewrite (@mem_head [eqType of pt]) orbT.
+        by rewrite (@mem_head pt).
+      by rewrite (@mem_head pt).
+    move=> /eqP <-; rewrite (@in_cons pt).
+    by rewrite (@mem_head pt) orbT.
     (* was by move=> /eqP <-; rewrite !inE eqxx orbT. *)
-  by rewrite (@in_cons [eqType of pt]) (@mem_head [eqType of pt]) orbT.
+  by rewrite (@in_cons pt) (@mem_head pt) orbT.
 move=> outp vl.
 have lgq : left_pt g = p' by apply/eqP; apply: (outp _ (mem_head _ _)).
 have vg : valid_edge g p' by rewrite -lgq valid_edge_left.
@@ -929,15 +929,15 @@ have {}outp : {in gs, forall g, left_pt g == p'}.
   by move=> g' gin; apply: outp; rewrite inE gin orbT.
 have {}Ih := Ih g outp vg.
 rewrite /=.
-rewrite 
+rewrite
  -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
 rewrite /= (pvertE vl); case oca_eq : (opening_cells_aux _ _ _ _)=> [nos lno].
 move: Ih; rewrite oca_eq /= => Ih.
 move=> c; rewrite inE=> /orP[/eqP -> /= |]; last by apply: Ih.
-case: ifP; last by rewrite (@mem_head [eqType of pt]).
+case: ifP; last by rewrite (@mem_head pt).
 rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
-by move=> /eqP <-; rewrite (@mem_head [eqType of pt]).
+by move=> /eqP <-; rewrite (@mem_head pt).
 Qed.
 
 Lemma last_opening_cells_side_char e le he pp nos lno :
@@ -992,7 +992,7 @@ have := opening_cells_last_left_pts vle vhe oute ogn0 puh.
 rewrite oca_eq /= => ->.
 have [ppuh /= | ] := boolP (pp <<< he); last by [].
 have [ppae /= | ] := boolP (p_y (point e) < p_y pp); last by [].
-rewrite !(@in_cons [eqType of pt]) !pt_eqE /=.
+rewrite !(@in_cons pt) !pt_eqE /=.
 have vpphe : valid_edge he pp by rewrite (same_x_valid _ samex).
 rewrite -(same_pvert_y vpphe samex).
 move: ppuh; rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[].
@@ -1069,7 +1069,7 @@ have := opening_cells_first_left_pts he vle ogn0 pal.
 rewrite oca_eq /= => ->.
 have [{}ppue /= | ] := boolP (p_y pp < p_y (point e)); last by [].
 have [ppal /= | ] := boolP (pp >>> le); last by [].
-rewrite !(@in_cons [eqType of pt]) !pt_eqE.
+rewrite !(@in_cons pt) !pt_eqE.
 have vpple : valid_edge le pp by rewrite (same_x_valid _ samex).
 rewrite -(same_pvert_y vpple samex).
 move: ppal; rewrite (under_pvert_y vpple) le_eqVlt negb_or=> /andP[].
@@ -1140,7 +1140,7 @@ have [ppe | ppne] := eqVneq (pp : pt) (point e).
   by rewrite /in_safe_side_left einl !andbF.
 have := opening_cells_left oute vle vhe.
 rewrite og0 /opening_cells /=.
-do 2 rewrite 
+do 2 rewrite
  -[generic_trajectories.vertical_intersection_point _ _ _ _ _ _ _ _ _ _ _]
    /(vertical_intersection_point _ _).
 rewrite (pvertE vle) (pvertE vhe) /= orbF.
@@ -1172,7 +1172,7 @@ have [ | pa] := lerP (p_y pp) (p_y (point e)); rewrite ?(andbF, orbF).
   have ppaly :  pvert_y (point e) le < p_y pp.
     rewrite -(same_pvert_y vpple samex).
     by rewrite ltNge -(under_pvert_y vpple).
-  rewrite !(@in_cons [eqType of pt]).
+  rewrite !(@in_cons pt).
   rewrite (negbTE ppne) !pt_eqE /=.
   move: ppaly; rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
   have ppuhy : p_y pp < pvert_y (point e) he.
@@ -1190,7 +1190,7 @@ rewrite /=.
 have ppaly :  pvert_y (point e) le < p_y pp.
   rewrite -(same_pvert_y vpple samex).
   by rewrite ltNge -(under_pvert_y vpple).
-rewrite !(@in_cons [eqType of pt]) (negbTE ppne) !pt_eqE /=.
+rewrite !(@in_cons pt) (negbTE ppne) !pt_eqE /=.
 move: ppaly; rewrite lt_neqAle eq_sym=> /andP[] /negbTE -> _.
 have ppuhy : p_y pp < pvert_y (point e) he.
   rewrite -(same_pvert_y vpphe samex).
diff --git a/theories/pol.v b/theories/pol.v
index ddaf53b..27fa66e 100644
--- a/theories/pol.v
+++ b/theories/pol.v
@@ -69,7 +69,7 @@ Proof.  by move=> lta; rewrite mulr_gt0 // invr_gt0 ltr0n. Qed.
 
 Lemma half_ltx x: 0 < x -> half x < x.
 Proof.
-by move=>lta; rewrite ltr_pdivr_mulr ?ltr0n // mulr_natr mulr2n ltr_addr.
+by move=>lta; rewrite ltr_pdivr_mulr ?ltr0n // mulr_natr mulr2n ltrDr.
 Qed.
 
 Lemma double_half x : half x + half x = x.
@@ -89,13 +89,13 @@ Proof. by rewrite /half mulrBl. Qed.
 Lemma mid_between (a b: R): a < b -> a < half (a + b) < b.
 Proof.
 move => h. rewrite - half_lin - {1} (double_half a) - {3} (double_half b).
-by rewrite  ltr_add2l  ltr_add2r ltr_pmul2r ?h //invr_gt0 ltr0n.
+by rewrite ltrD2l ltrD2r ltr_pM2r ?h //invr_gt0 ltr0n.
 Qed.
 
 Lemma maxS (x y: R) (z := (Num.max x y) +1) : (x<z) && (y <z).
 Proof.
 have p1 : forall u v:R, u <= v -> u < v + 1.
-       by move=> u v  h; rewrite (le_lt_trans h) // ltr_addl ltr01.
+       by move=> u v  h; rewrite (le_lt_trans h) // ltrDl ltr01.
 by rewrite !p1// ?le_maxr// lexx // orbT.
 Qed.
 
@@ -103,21 +103,21 @@ Lemma pmul2w1 (a b c d : R) : 0 <= a -> 0 <= d -> a <= b -> c <= d ->
    a * c <= b * d.
 Proof.
 move => a0 d0 ab cd.
-apply: (le_trans (ler_wpmul2l a0 cd)).
-by apply: (le_trans (ler_wpmul2r d0 ab)).
+apply: (le_trans (ler_wpM2l a0 cd)).
+by apply: (le_trans (ler_wpM2r d0 ab)).
 Qed.
 
 Lemma inv_comp x y:  0 < x -> 0 < y -> (x < y^-1) = (y < x^-1).
 Proof.
 move=> xp yp.
-rewrite -(ltr_pmul2r yp) - [y < _](ltr_pmul2l xp).
+rewrite -(ltr_pM2r yp) - [y < _](ltr_pM2l xp).
 by rewrite mulVf ?(gt_eqF yp) //  mulfV // (gt_eqF xp).
 Qed.
 
 Lemma inv_compr x y: 0 < x -> 0 < y -> (y^-1 < x) = (x^-1 < y).
 Proof.
 move=> xp yp.
-rewrite -(ltr_pmul2r yp) - [_ < y](ltr_pmul2l xp).
+rewrite -(ltr_pM2r yp) - [_ < y](ltr_pM2l xp).
 by rewrite mulVf ?(gt_eqF yp) //  mulfV // (gt_eqF xp).
 Qed.
 
@@ -159,7 +159,7 @@ Lemma bigmaxr_le0 s F:
   \max_(i <- s) F i <= 0 -> forall i, i \in s -> F i <= 0.
 Proof.
 elim: s; first by move=> _ i;rewrite in_nil.
-move=> k s IHs; rewrite big_cons le_maxl; case /andP => Fk Hr1 i.
+move=> k s IHs; rewrite big_cons ge_max; case /andP => Fk Hr1 i.
 rewrite in_cons; case /orP; [ move /eqP ->; apply: Fk | by apply: IHs].
 Qed.
 
@@ -197,7 +197,7 @@ Proof.
 move=> h; apply: (iffP idP) => leFm => [i ir | ].
   by apply: le_trans leFm; apply: bigmaxr_le.
 rewrite big_seq_cond; elim /big_ind:_ => //.
-  by  move=> x y xm ym; rewrite le_maxl; apply /andP.
+  by  move=> x y xm ym; rewrite ge_max; apply /andP.
 by  move=> i; rewrite andbT; apply: leFm.
 Qed.
 
@@ -241,7 +241,7 @@ Qed.
 Lemma bigmaxf_le0 f n: \max_(i < n) f i <= 0 ->
    forall i, (i <n)%N -> f i <= 0.
 Proof.
-elim: n => [_ i //| n Hr]; rewrite bigmaxf_rec le_maxl; case /andP => Fk H i.
+elim: n => [_ i //| n Hr]; rewrite bigmaxf_rec ge_max; case /andP => Fk H i.
 rewrite ltnS leq_eqVlt; case /orP; [ move /eqP ->; apply: Fk | by apply: Hr].
 Qed.
 
@@ -277,7 +277,7 @@ Proof.
 move=> h; apply: (iffP idP) => leFm => [i ir | ].
   by apply: le_trans leFm; apply: bigmaxf_le.
 rewrite big_seq_cond; elim /big_ind:_ => //.
-  by  move=> x y xm ym; rewrite le_maxl; apply /andP.
+  by  move=> x y xm ym; rewrite ge_max; apply /andP.
 by move=> [i hi] _; apply: leFm.
 Qed.
 
@@ -297,7 +297,7 @@ apply: le_trans (_: \sum_(i < n) `| f i * g i| <= _).
   apply: ler_norm_sum.
 have ->:  \sum_(i < n) `|f i * g i|  =  \sum_(i < n) `|f i|  * `|g i|.
   by apply: eq_big => // i; rewrite normrM.
-rewrite  mulr_sumr; apply: ler_sum => i _; apply: ler_wpmul2r.
+rewrite  mulr_sumr; apply: ler_sum => i _; apply: ler_wpM2r.
   by rewrite normr_ge0.
 by apply: (bigmaxf_le (fun i => `|f i|)).
 Qed.
@@ -307,7 +307,7 @@ Lemma normr_sumprod1 f g n b:
   `| \sum_(i< n) (f i * g i) |  <= b * \sum_ (i<n) `| g i|.
 Proof.
 move=> b0 h; apply: (le_trans (normr_sumprod f g n)).
-apply: ler_wpmul2r;  first by rewrite sumr_ge0 // => i _; rewrite absr_ge0.
+apply: ler_wpM2r;  first by rewrite sumr_ge0 // => i _; rewrite absr_ge0.
 exact /(bigmaxf_lerP (fun z => `|f z|)  n b0).
 Qed.
 
@@ -843,9 +843,9 @@ move: (sum_powers_of_x (m.+1) `|x|); set aux:= (\sum_(i < m.+1) _) => pa.
 set c := \max_(i < m.+1) `|E i / E m.+1| => cp r1.
 have a1p: 0 < `|x| - 1 by rewrite subr_gt0.
 have r2 : c* aux <= c* ( (`|x| ^+ m.+1) /(`|x| - 1)).
-  by rewrite  (ler_wpmul2l cp) // ler_pdivl_mulr // mulrC pa ger_addl lerN10.
-move:  (le_trans r1 r2); rewrite mulrA  ler_pdivl_mulr // mulrC.
-rewrite normrX ler_pmul2r //.
+  by rewrite  (ler_wpM2l cp) // ler_pdivlMr // mulrC pa ger_addl lerN10.
+move:  (le_trans r1 r2); rewrite mulrA ler_pdivlMr // mulrC.
+rewrite normrX ler_pM2r //.
 by apply:(lt_trans ltr01); rewrite exprn_egt1.
 Qed.
 
@@ -853,7 +853,7 @@ Lemma CauchyBound2 : `| x | <= \sum_(i < n.+1) `|E i / E n|.
 Proof.
 case: (lerP `|x| 1)=> cx1.
   apply: (le_trans cx1).
-  rewrite big_ord_recr /= divff // normr1 ler_addr.
+  rewrite big_ord_recr /= divff // normr1 lerDr.
   rewrite sumr_ge0 // => i _; rewrite  absr_ge0 //.
 move: (CauchyBound_aux).
 case e: n=> [| m].
@@ -869,7 +869,7 @@ move => h1; have h2 :  x =  - \sum_(i < m.+1) ( x^-(m - i) *(E i / E m.+1)).
     expf_eq0 x0 andbF.
 rewrite (f_equal (fun z => `| z |) h2) normrN.
 apply: le_trans (_: (\sum_(i < m.+1) `|E i / E m.+1|) <= _); last first.
-  by rewrite (big_ord_recr m.+1) /= ler_addl normr_ge0.
+  by rewrite (big_ord_recr m.+1) /= lerDl normr_ge0.
 have pa:  (forall i, (i<m.+1)%N ->  `| x ^- (m - i) | <= 1).
   move => i lin.
   have pa: 0 < `|x ^+ (m - i)| by rewrite normr_gt0  expf_eq0 x0 andbF.
@@ -909,7 +909,7 @@ Lemma diff_xn_ub n (z x y: R): -z  <= x -> x <= y -> y <= z ->
      `| y ^+ n - x ^+ n| <=  (z^+(n.-1) *+ n) * (y - x).
 Proof.
 move => zx xy yz.
-rewrite subrXX mulrC normrM [`|_ - _|]ger0_norm ?ler_wpmul2r // ?subr_ge0 //.
+rewrite subrXX mulrC normrM [`|_ - _|]ger0_norm ?ler_wpM2r // ?subr_ge0 //.
 apply: (le_trans (ler_norm_sum _ _ _)).
 rewrite - [n in _*+ n] card_ord  - sumr_const ler_sum // => [][i lin] _.
 rewrite normrM !normrX.
@@ -934,7 +934,7 @@ have ->: aux =  ((\sum_(i<size p) `|p`_i| * (z^+(i.-1) *+ i)) * (y - x)).
   move => s1; rewrite - (prednK s1) size_deriv big_ord_recl mulr0n mulr0 add0r.
   apply: eq_bigr => i _; rewrite coef_deriv normrMn mulrnAl mulrnAr //.
 rewrite big_distrl /= ler_sum // => i _;rewrite - mulrBr normrM  -mulrA.
-apply: (ler_wpmul2l (normr_ge0 p`_i)); exact: (diff_xn_ub i zx xy yz).
+apply: (ler_wpM2l (normr_ge0 p`_i)); exact: (diff_xn_ub i zx xy yz).
 Qed.
 
 Lemma pol_ucont (p : {poly R}) a b (c := (norm_pol p^`()).[(Num.max (- a) b)]) :
@@ -952,24 +952,24 @@ Lemma pol_cont (p : {poly R}) (x eps :R):  0 < eps ->
 Proof.
 move => ep.
 move: (pol_ucont p (a:= x-1)(b:=x+1)); set c := _ .[_ ] => /= hc.
-have pa: x-1 <= x by move: (ler_add2l x (-1) 0); rewrite addr0 lerN10.
-have pb: x <= x+1 by move: (ler_add2l x 0 1); rewrite ler01 addr0.
+have pa: x-1 <= x by move: (lerD2l x (-1) 0); rewrite addr0 lerN10.
+have pb: x <= x+1 by move: (lerD2l x 0 1); rewrite ler01 addr0.
 have cp: 0<=c.
   move: (hc _ _ pa pb (lexx (x+1))).
   by rewrite  addrAC addrN add0r mulr1; apply: le_trans; rewrite normr_ge0.
 exists (Num.min 1  (eps /(c+1))).
   rewrite lt_minr ltr01 /= divr_gt0 // ? ep //.
-  by apply: (lt_le_trans ltr01); move: (ler_add2r 1 0 c); rewrite add0r cp.
+  by apply: (lt_le_trans ltr01); move: (lerD2r 1 0 c); rewrite add0r cp.
 move => y.
 rewrite lt_minr; case /andP => xy1 xy2.
 apply: (@le_lt_trans _ _ (c *  `|(y - x)|)); last first.
    move: cp; rewrite le0r; case /orP; first by move /eqP => ->; rewrite mul0r.
    move => cp.
-   rewrite - (ltr_pmul2l cp) in xy2; apply: (lt_le_trans xy2).
+   rewrite -(ltr_pM2l cp) in xy2; apply: (lt_le_trans xy2).
    rewrite mulrCA  ger_pmulr //.
-   have c1: c <= c + 1  by move: (ler_add2l c 0 1); rewrite ler01 addr0.
+   have c1: c <= c + 1  by move: (lerD2l c 0 1); rewrite ler01 addr0.
    have c1p := (lt_le_trans cp c1).
-   by rewrite -(ler_pmul2r c1p) mulfVK ? (gt_eqF c1p) // mul1r.
+   by rewrite -(ler_pM2r c1p) mulfVK ? (gt_eqF c1p) // mul1r.
 move: (ltW xy1); rewrite ler_distl;case /andP => le1 le2.
 case /orP: (le_total x y) => xy.
    move: (xy); rewrite - subr_ge0 => xy'.
@@ -1052,21 +1052,21 @@ have c2p: 0 < v-u by rewrite subr_gt0.
 have hh1: (v-u) * c < eps.
    rewrite pa;set x := (X in _ / X).
    have xp: 0 < x by rewrite exprn_gt0 // ltr0n.
-   rewrite mulrAC  -(ltr_pmul2r xp) (mulrVK (unitf_gt0 xp)).
+   rewrite mulrAC  -(ltr_pM2r xp) (mulrVK (unitf_gt0 xp)).
    move: hh.
    rewrite -/x.
    by rewrite ltr_pdivr_mulr// (mulrC _ x).
 have hh2 : v-u < eps.
-  by apply: le_lt_trans hh1; rewrite - {1} (mulr1 (v-u)) (ler_pmul2l c2p).
+  by apply: le_lt_trans hh1; rewrite - {1} (mulr1 (v-u)) (ler_pM2l c2p).
 have dvp: p.[u] < p.[v] by apply (lt_le_trans  pun pvp).
 have hh5: p.[v] - p.[u] <= eps.
   move: (pc _ _ ha (ltW hb) hc);rewrite gtr0_norm ? subr_gt0 // mulrC => hh4.
   apply:(le_trans _ (ltW hh1)); apply: (le_trans hh4).
-  rewrite (ler_pmul2l c2p) le_maxr lexx orbT //.
+  rewrite (ler_pM2l c2p) le_maxr lexx orbT //.
 rewrite eq1 /pair_in_interval pun pvp dvp  (ltW hh2) ler_oppl.
 rewrite  (le_trans _ hh5) ?(le_trans _ hh5) //.
-   by rewrite -{1} (addr0 p.[v]) ler_add2l oppr_ge0 ltW.
-by rewrite -{1} (add0r (- p.[u])) ler_add2r.
+   by rewrite -{1} (addr0 p.[v]) lerD2l oppr_ge0 ltW.
+by rewrite -{1} (add0r (- p.[u])) lerD2r.
 Qed.
 
 Lemma constructive_ivt_bis  (p : {poly R})(a b : R) (eps: R):
@@ -1090,12 +1090,12 @@ Lemma constructive_ivt_ter  (p : {poly R})(a b : R) (eps: R):
       (p.[xy.2] <= eps) && (a <= xy.1) && (xy.1 < xy.2) && (xy.2 <= b) }.
 Proof.
 move=> ab nla plb ep.
-have ba' : 0 < b - a by rewrite -(addrN a) ltr_add2r.
+have ba' : 0 < b - a by rewrite -(addrN a) ltrD2r.
 have evalba : 0 < p.[b] - p.[a] by rewrite subr_gt0;  exact: lt_le_trans plb.
 move: (pol_ucont p (a:=a) (b:= b)).
 set c := _ .[_ ] => /= pc.
 have cpos : 0 < c.
-  rewrite - (ltr_pmul2r ba') mul0r.
+  rewrite - (ltr_pM2r ba') mul0r.
   by apply: lt_le_trans (pc a b _ _ _) => //; rewrite ? ger0_norm // ltW.
 have pdiv : (0 < (b - a) * c / eps) by rewrite ltr_pdivl_mulr // mul0r mulr_gt0.
 move: (archi_boundP (ltW pdiv)); set n := Num.bound _ => qn.
@@ -1120,7 +1120,7 @@ move/(@before_find _ 0 (fun x : R => 0 <= p.[x]) sl); move/negbT.
 rewrite -ltNge => pa'n.
 move:(ltW ba') => ba'w.
 have aa' : a <= a'.
-  rewrite /a'/sl (nth_map 0%N) // ler_addl mulr_ge0 //.
+  rewrite /a'/sl (nth_map 0%N) // lerDl mulr_ge0 //.
   by rewrite mulr_ge0 // ?invr_ge0 ?ler0n.
 have ia'_sharp : (ia' < n.+1)%N.
   move: ia'iota; rewrite leq_eqVlt; rewrite size_iota; case/orP=> //.
@@ -1131,8 +1131,8 @@ have ia'_sharp : (ia' < n.+1)%N.
 have b'b : b' <= b.
   rewrite /b'/sl (nth_map 0%N) ?size_iota ?ltnS // nth_iota // add0n.
   have e : b = a + (b - a) by rewrite addrCA subrr addr0.
-  rewrite {2}e {e} ler_add2l //= -{2}(mulr1 (b -a)) ler_wpmul2l //.
-    rewrite ler_pdivr_mulr ?ltr0Sn // mul1r -subr_gte0 /=.
+  rewrite {2}e {e} lerD2l //= -{2}(mulr1 (b -a)) ler_wpM2l //.
+    rewrite ler_pdivrMr ?ltr0Sn // mul1r -subr_gte0 /=.
     have -> : (n.+1 = ia'.+1 + (n.+1 - ia'.+1))%N by rewrite subnKC.
     by rewrite mulrnDr addrAC subrr add0r subSS ler0n.
 have b'a'_sub : b' - a' = (b - a) / (n.+1)%:R.
@@ -1142,18 +1142,18 @@ have b'a'_sub : b' - a' = (b - a) / (n.+1)%:R.
   rewrite opprD addrAC addrA subrr add0r addrC -mulrBr.
   by congr (_ * _); rewrite -mulrBl mulrSr addrAC subrr add0r div1r.
 have a'b' :  a' < b'.
-  move/eqP: b'a'_sub; rewrite subr_eq; move/eqP->; rewrite ltr_addr.
+  move/eqP: b'a'_sub; rewrite subr_eq; move/eqP->; rewrite ltrDr.
   by rewrite mulr_gt0 // invr_gt0 ltr0Sn.
 rewrite pa'n a'b' b'b aa' pb'p.
 have : `|p.[b'] - p.[a']| <= eps.
     have := (pc sl`_ia' sl`_ia'.+1 aa' (ltW a'b') b'b).
     rewrite b'a'_sub => hpc; apply: le_trans hpc _ => /=.
-    rewrite mulrA ler_pdivr_mulr ?ltr0Sn // mulrC [eps * _]mulrC.
-    rewrite -ler_pdivr_mulr //; apply: (ltW  qn).
+    rewrite mulrA ler_pdivrMr ?ltr0Sn // mulrC [eps * _]mulrC.
+    rewrite -ler_pdivrMr //; apply: (ltW  qn).
 case/ler_normlP => h1 h2.
 rewrite ler_oppl/= !andbT.
-rewrite -[in X in X && _](ler_add2l p.[b']) (le_trans h2) ? ler_addr //.
-by rewrite -(ler_add2r (- p.[a'])) (le_trans h2) // ler_addl oppr_gte0 ltW.
+rewrite -[in X in X && _](lerD2l p.[b']) (le_trans h2) ? lerDr //.
+by rewrite -(lerD2r (- p.[a'])) (le_trans h2) // lerDl oppr_gte0 ltW.
 Qed.
 
 End PolsOnArchiField.
diff --git a/theories/poly_normal.v b/theories/poly_normal.v
index 102b62b..326e7cd 100644
--- a/theories/poly_normal.v
+++ b/theories/poly_normal.v
@@ -184,7 +184,7 @@ rewrite exprMn_comm; last first.
 rewrite sqrrN.
 rewrite -natrX.
 rewrite (mulr_natl _ (2 ^ 2)).
-rewrite [_ ^+2 *+ _]mulrS ler_add2l -mulr_natl -andbA /=.
+rewrite [_ ^+2 *+ _]mulrS lerD2l -mulr_natl -andbA /=.
 apply/idP/idP => [/orP [] | H].
     rewrite eq_sym paddr_eq0 ?sqr_ge0 //.
     case/andP => /eqP -> /eqP ->.
@@ -350,7 +350,7 @@ case : (leqP k (size p).-1) => Hk2.
   rewrite coefM (bigD1 ord0) //= subn0 (lt_le_trans (y := (p`_0 * q`_k))) //.
     rewrite pmulr_lgt0; first by rewrite Hpcoef.
     by rewrite Hqcoef // (@leq_trans ((size p).-1)).
-  rewrite ler_addl sumr_ge0 //.
+  rewrite lerDl sumr_ge0 //.
   case => /= i Hi Hi2.
   rewrite pmulr_rge0.
     case Hki : (k - i <= (size q).-1)%N.
@@ -370,7 +370,7 @@ rewrite (bigD1 (Ordinal Hk3)) //=
       -[size q]prednK ?size_poly_gt0 // addSn addnS -!pred_Sn in Hk.
   rewrite pmulr_rgt0; first by rewrite Hqcoef.
   by apply: Hpcoef.
-rewrite ler_addl sumr_ge0 //.
+rewrite lerDl sumr_ge0 //.
 case => /= i Hi Hi2.
 apply: mulr_ge0.
   case Hi3 : (i <= (size p).-1)%N.
diff --git a/theories/preliminaries.v b/theories/preliminaries.v
index 8d3c3a4..1d0f456 100644
--- a/theories/preliminaries.v
+++ b/theories/preliminaries.v
@@ -39,8 +39,7 @@ Qed.
 
 (* TODO: do we keep this as more newcomer friendly than having to look
    deep into the library ? *)
-Lemma enum_prodE {T1 T2 : finType} :
-  enum [finType of T1 * T2] = prod_enum T1 T2.
+Lemma enum_prodE {T1 T2 : finType} : enum {: T1 * T2} = prod_enum T1 T2.
 Proof.
 by rewrite /enum_mem unlock /= /prod_enum -(@eq_filter _ predT) ?filter_predT.
 Qed.
@@ -114,10 +113,10 @@ by exists (a' :: s').
 Qed.
 
 Lemma index_enum_cast_ord n m (e: n = m) :
-  index_enum [finType of 'I_m] = [seq (cast_ord e i) | i <- index_enum [finType of 'I_n]].
+  index_enum 'I_m = [seq (cast_ord e i) | i <- index_enum 'I_n].
 Proof.
 subst m.
-rewrite -{1}(map_id (index_enum [finType of 'I_n])).
+rewrite -{1}(map_id (index_enum 'I_n)).
 apply eq_map=>[[x xlt]].
 rewrite /cast_ord; congr Ordinal; apply bool_irrelevance.
 Qed.
@@ -199,7 +198,7 @@ Lemma size_index_enum (T: finType): size (index_enum T) = #|T|.
 Proof. by rewrite cardT enumT. Qed.
 
 Lemma map_nth_ord [T : Type] (x: T) (s : seq T) :
-  [seq nth x s (nat_of_ord i) | i <- index_enum [finType of 'I_(size s)]] = s.
+  [seq nth x s (nat_of_ord i) | i <- index_enum 'I_(size s)] = s.
 Proof.
 rewrite /index_enum; case: index_enum_key=>/=; rewrite -enumT.
 elim: s=>/= [| a s IHs].

From f6c99519215ce0638df2a33294bb61228c6913a8 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Tue, 23 Apr 2024 15:14:02 +0900
Subject: [PATCH 11/43] less warnings

---
 theories/casteljau.v             |  2 +-
 theories/cells.v                 |  8 ++---
 theories/convex.v                | 22 ++++++------
 theories/desc.v                  | 14 ++++----
 theories/isolate.v               |  2 +-
 theories/math_comp_complements.v | 20 +++++------
 theories/pol.v                   | 61 ++++++++++++++++----------------
 theories/poly_normal.v           |  8 ++---
 theories/safe_cells.v            | 58 +++++++++++++++---------------
 9 files changed, 97 insertions(+), 98 deletions(-)

diff --git a/theories/casteljau.v b/theories/casteljau.v
index 9b2ec04..6f1c6bb 100644
--- a/theories/casteljau.v
+++ b/theories/casteljau.v
@@ -1289,7 +1289,7 @@ have ublt : ub < ub' by rewrite ltr_pwDr // ltr01.
 pose x := minr (a - p.[a]/ub') (half (a + b)).
 have xitv2 : a < x < b.
   by case/andP: (mid_between ab)=> A B; rewrite lt_min ltr_pwDr ?A //=
-    ?lt_minl ?B ?orbT // -mulNr mulr_gt0 // ?invr_gt0 // oppr_gt0.
+    ?gt_min ?B ?orbT // -mulNr mulr_gt0 // ?invr_gt0 // oppr_gt0.
 have xitv : a <= x <= b by case/andP: xitv2 => *; rewrite !ltW //.
 have := cp _ xitv2.
 rewrite [X in X.[x]]pq hornerD hornerC hornerM hornerXsubC.
diff --git a/theories/cells.v b/theories/cells.v
index b901345..54b3cfe 100644
--- a/theories/cells.v
+++ b/theories/cells.v
@@ -610,8 +610,8 @@ Definition all_edges cells events :=
 Lemma mono_cell_edges s1 s2 : {subset s1 <= s2} ->
   {subset cell_edges s1 <= cell_edges s2}.
 Proof.
-by move=> sub g; rewrite mem_cat => /orP[] /mapP[c cin geq];
-  rewrite /cell_edges geq mem_cat map_f ?orbT // sub.
+by move=> Sub g; rewrite mem_cat => /orP[] /mapP[c cin geq];
+  rewrite /cell_edges geq mem_cat map_f ?orbT // Sub.
 Qed.
 
 Lemma cell_edges_catC s1 s2 :
@@ -1368,9 +1368,9 @@ Qed.
 
 End open_cells_decomposition.
 
-Lemma inside_open_cell_valid c p1 : 
+Lemma inside_open_cell_valid c p1 :
   open_cell_side_limit_ok c ->
-  inside_open_cell p1 c -> 
+  inside_open_cell p1 c ->
   valid_edge (low c) p1 && valid_edge (high c) p1.
 Proof.
 move=> /andP[] ne /andP[] sxl /andP[] _ /andP[] /andP[] _ onh /andP[] _ onl.
diff --git a/theories/convex.v b/theories/convex.v
index 206337d..e9af65b 100644
--- a/theories/convex.v
+++ b/theories/convex.v
@@ -58,10 +58,10 @@ rewrite Convn_pair/comp/=; congr pair; apply S1_inj; rewrite !S1_Convn big_prod_
   under eq_bigr => j _ do rewrite -[e j * d i]/(h j).
   rewrite scalept_sum; apply eq_big=>// j _.
   rewrite /h /= fdistmapE.
-  have -> : (\sum_(a in [finType of 'I_n * 'I_m] |
+  have -> : (\sum_(a in {: 'I_n * 'I_m} |
                    a \in preim (@unsplit_prod _ m) (pred1 (Ordinal (unsplit_prodp i j))))
               (fdist_prod d (fun=> e)) a =
-             \sum_(a in [finType of 'I_n * 'I_m] | a \in pred1 (i, j))
+             \sum_(a in {: 'I_n * 'I_m} | a \in pred1 (i, j))
               (fdist_prod d (fun=> e)) a)%coqR.
      apply eq_big=>// k; congr andb; rewrite 3!inE.
      by apply: (eqtype.inj_eq _ k (i, j)); exact: (can_inj (@unsplit_prodK _ _)).
@@ -75,14 +75,14 @@ have @h : nneg_fun 'I_n.
 (* BUG HB.pack *)
    exists (fun i => d i * e j)%coqR => i.
    by apply: ssrR.mulR_ge0.
-under eq_bigr => i _ do rewrite -[d i * e j]/(h i).    
+under eq_bigr => i _ do rewrite -[d i * e j]/(h i).
 rewrite scalept_sum; apply: eq_big => // i _.
 rewrite /h/= fdistmapE.
-have -> : (\sum_(a in [finType of 'I_n * 'I_m] |
+have -> : (\sum_(a in {: 'I_n * 'I_m} |
    a \in preim (unsplit_prod (n:=m)) (pred1 (Ordinal (unsplit_prodp i j))))
           (fdist_prod d (fun=> e)) a =
    \sum_(a in
-   [finType of 'I_n * 'I_m] | a \in pred1 (i, j))
+   {: 'I_n * 'I_m} | a \in pred1 (i, j))
        (FDist.f (fdist_prod d (fun=> e))) a)%coqR.
    apply: eq_big=>// k; congr andb; rewrite 3!inE.
    by apply: (eqtype.inj_eq _ k (i, j)); exact (can_inj (@unsplit_prodK _ _)).
@@ -226,7 +226,7 @@ split.
       have [tle|tle] := leP (Prob.p t) (2^-1); first exact: (h u v t).
       rewrite convC.
       apply (h v u (onem t)%:pr)=>//.
-      rewrite -onem_half; apply ler_sub=>//.
+      rewrite -onem_half; apply: lerB=>//.
       exact/ltW.
    move=>tle.
    have t01: ((Rdefinitions.IZR BinNums.Z0) <= 2%:R * (Prob.p t : R)) &&
@@ -306,7 +306,7 @@ split; move=>[hex hface]; split=>//.
          by apply (h f a).
       move: h=>/(_ (f \o (@GRing.opp E)) (- a)).
       have hf' (x : E) : x \in A -> (f \o (@GRing.opp E)) x <= - a.
-        by move=> xA /=; rewrite -scaleN1r linearZZ scaleN1r ler_oppl opprK; apply hf.
+        by move=> xA /=; rewrite -scaleN1r linearZZ scaleN1r lerNl opprK; apply hf.
       have hex': exists x : E, x \in A /\ (f \o (@GRing.opp E)) x = - a.
          by move: hex=>[x [xA fx]]; exists x; split=>//=; rewrite -fx -scaleN1r linearZZ scaleN1r.
       move=>/(_ hex' (or_introl hf') hf'); congr (face A (A `&` _)).
@@ -319,7 +319,7 @@ split; move=>[hex hface]; split=>//.
    have tgt : 0 < (Prob.p t : R) by rewrite lt0r t0=>/=.
    move: tx=>/(f_equal (fun x=> (Prob.p t : R)^-1 *: (x - (onem t) *: v))).
    rewrite -addrA subrr addr0 scalerA mulVf // scale1r=>->.
-   rewrite linearZZ linearD xa -scaleNr linearZZ ler_pdivl_mull// addrC -subr_ge0 -addrA -mulNr -{1}[a]mul1r -mulrDl scaleNr -scalerN -mulrDr; apply mulr_ge0 => //.
+   rewrite linearZZ linearD xa -scaleNr linearZZ ler_pdivlMl// addrC -subr_ge0 -addrA -mulNr -{1}[a]mul1r -mulrDl scaleNr -scalerN -mulrDr; apply mulr_ge0 => //.
    by rewrite addrC Num.Internals.subr_ge0; apply hf.
 have : forall x y, x \in A -> y \in A -> f x < a -> a < f y -> False.
    move=> u v uA vA fua afv.
@@ -328,7 +328,7 @@ have : forall x y, x \in A -> y \in A -> f x < a -> a < f y -> False.
   (((f v - a) / (f v - f u))%R <= Rdefinitions.IZR (BinNums.Zpos 1%AC)).
       apply/andP; split.
          by apply divr_ge0; apply ltW=>//; rewrite subr_gt0.
-         rewrite ler_pdivr_mulr// mul1r -subr_ge0 opprB addrAC addrCA subrr addr0 subr_ge0.
+         rewrite ler_pdivrMr// mul1r -subr_ge0 opprB addrAC addrCA subrr addr0 subr_ge0.
          by apply ltW.
    move: hface=>/face'P [_ _ /(_ (u <| Prob.mk t01 |> v) u v)].
    have inuv: u <| Prob.mk t01 |> v \in segment u v.
@@ -450,7 +450,7 @@ have ->: \sum_(i | true && ~~ (0 < d i)) (t : R) *: (d i *: s i) = \sum_(i | tru
    move:(FDist.ge0 d i)=>->; rewrite orbF=>/eqP->.
    by rewrite 2!scale0r GRing.scaler0.
 rewrite -[\sum_(_ < _ | _) 0 *: 0]scaler_sumr scale0r addr0 -big_filter /=.
-remember [seq i <- index_enum [finType of 'I_n] | 0 < d i] as I; move: HeqI=>/esym HeqI.
+remember [seq i <- index_enum 'I_n | 0 < d i] as I; move: HeqI=>/esym HeqI.
 case: I HeqI=> [| i I] HeqI.
    exfalso; move: (FDist.f1 d) (oner_neq0 R); rewrite (@bigID_idem _ _ _ _ _ _ (fun i=> 0 < d i))/=; [|apply addr0 ].
    rewrite -big_filter HeqI big_nil/=.
@@ -460,7 +460,7 @@ case: I HeqI=> [| i I] HeqI.
    apply congr_big=>// i /= dile; move: (FDist.ge0 d i); rewrite le0r.
    rewrite (negbTE dile) orbF => /eqP ->.
    by rewrite mul0R.
-have: subseq (i::I) (index_enum [finType of 'I_n]) by rewrite -HeqI; apply filter_subseq.
+have: subseq (i::I) (index_enum 'I_n) by rewrite -HeqI; apply filter_subseq.
 case: n s d sA i I HeqI=> [| n] s d sA i I HeqI.
    by inversion i.
 move=> /subseq_incl; move=> /(_ ord0); rewrite size_index_enum card_ord; move=> [f [fn flt]].
diff --git a/theories/desc.v b/theories/desc.v
index 9bb419c..30e5ffa 100644
--- a/theories/desc.v
+++ b/theories/desc.v
@@ -1,5 +1,5 @@
 From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq  choice fintype order.
-From mathcomp Require Import binomial  bigop ssralg poly ssrnum ssrint rat.
+From mathcomp Require Import binomial  bigop ssralg poly ssrnum ssrint rat archimedean.
 From mathcomp Require Import polyrcf.
 Require Import pol.
 
@@ -1093,7 +1093,7 @@ have cp0 : 0 < c.
 set b := Num.min y (b' +(half e1)/c).
 have blty: b <= y by  rewrite /b ge_min lexx.
 have b'b: b' < b.
-  rewrite lt_minr (le_lt_trans b'y' y'y) /= - ltrBlDl addrN.
+  rewrite lt_min (le_lt_trans b'y' y'y) /= - ltrBlDl addrN.
   by rewrite (divr_gt0 (half_gt0 e1p) cp0).
 have clb:c * (b - b') < e1.
   apply: le_lt_trans (half_ltx e1p).
@@ -1169,14 +1169,14 @@ have k2p : k2 = (k * x1 ^+ 2 * y ^-1 ^+ s) by apply: double_half.
 rewrite (_ : k' = k1 + k2); last by rewrite /k1 /k2 addrA addNr add0r.
 have xzi: z^-1 < x^-1 by rewrite ltf_pV2.
 have pa : x1 <=  z^-1.
-  by rewrite (le_trans x1a)// -(invrK a)// lef_pinv// posrE invr_gt0.
+  by rewrite (le_trans x1a)// -(invrK a)// lef_pV2// posrE invr_gt0.
 have pb: x1 <=  x^-1 by rewrite (ltW (le_lt_trans pa xzi)).
 have pc: 0 <= k * (x^-1 - z^-1) by apply: ltW;rewrite(mulr_gt0 kp) // subr_gt0.
 have pdd:(x1 <= z^-1 <= x^-1) by rewrite pa (ltW xzi).
 have pd:= (sl _ _ pdd).
 have t3p:=  le_trans pc pd.
 have pe : 0 <= y^-1 <= z.
-  by rewrite invr_ge0 ltW //= (le_trans _ (ltW xz))// (le_trans _ bvx)// lef_pinv.
+  by rewrite invr_ge0 ltW //= (le_trans _ (ltW xz))// (le_trans _ bvx)// lef_pV2.
 case /andP: (pow_monotone s pe) => _ hh.
 have maj' : t3 * y^-1 ^+ s <= t3 * z^+ s by rewrite ler_wpM2l.
 rewrite mulrDl; apply: lerD; last first.
@@ -1201,11 +1201,11 @@ have xzexp' : (z ^+ s - x ^+ s) >= 0 by rewrite subr_ge0 - subr_le0.
 rewrite /t1 /k1 /k' {maj' t2 t3}.
 case: (lerP 0 ( q.[x^-1])) => sign; last first.
   apply: le_trans  (_ : 0 <= _).
-   by rewrite mulNr lter_oppl oppr0  mulr_ge0 //?(ltW k'p)// subr_gte0 /= ltW.
+   by rewrite mulNr lterNl oppr0 mulr_ge0 //?(ltW k'p)// subr_gte0 /= ltW.
   by rewrite mulr_le0 // ltW.
-rewrite mulNr lter_oppl -mulNr opprD  opprK addrC.
+rewrite mulNr lterNl -mulNr opprD opprK addrC.
 have rpxe : q.[x^-1] <= e.
-  have bvx' : x^-1 <= b by rewrite -(invrK b)// lef_pinv.
+  have bvx' : x^-1 <= b by rewrite -(invrK b)// lef_pV2.
   apply: (@le_trans _ _ q.[b]).
      have aux:(x1 <= x^-1 <= b) by rewrite pb bvx'.
     rewrite -subr_ge0 /= ;apply: le_trans (sl _ _ aux).
diff --git a/theories/isolate.v b/theories/isolate.v
index 6d725f1..2270bb4 100644
--- a/theories/isolate.v
+++ b/theories/isolate.v
@@ -1,6 +1,6 @@
 From HB Require Import structures.
 From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq choice fintype order.
-From mathcomp Require Import div finfun bigop prime binomial ssralg finset fingroup finalg.
+From mathcomp Require Import div finfun bigop prime binomial ssralg finset fingroup finalg archimedean.
 From mathcomp Require Import mxalgebra perm zmodp matrix ssrint.
 (*From mathcomp Require Import (*refinements NB(rei) funperm*).*)
 From mathcomp Require Import seq rat.
diff --git a/theories/math_comp_complements.v b/theories/math_comp_complements.v
index 22303b5..fdc5a5b 100644
--- a/theories/math_comp_complements.v
+++ b/theories/math_comp_complements.v
@@ -20,16 +20,16 @@ Fixpoint seq_subst {A : eqType}(l : seq A) (b c : A) : seq A :=
 Lemma mem_seq_subst {A : eqType} (l : seq A) b c x :
   x \in (seq_subst l b c) -> (x \in l) || (x == c).
 Proof.
-elim: l => [// | a l Ih].  
+elim: l => [// | a l Ih].
 rewrite /=.
 by case: ifP => [] ?; rewrite !inE=> /orP[ | /Ih /orP[] ] ->; rewrite ?orbT.
 Qed.
-  
+
 Lemma seq_subst_eq0  {A : eqType} (l : seq A) b c :
   (seq_subst l b c == [::]) = (l == [::]).
 Proof. by case : l => [ | a l] //=; case: ifP. Qed.
 
-Lemma seq_subst_cat {A : eqType} (l1 l2 : seq A) b c : 
+Lemma seq_subst_cat {A : eqType} (l1 l2 : seq A) b c :
   seq_subst (l1 ++ l2) b c = seq_subst l1 b c ++ seq_subst l2 b c.
 Proof.
 elim: l1 => [ // | a l1 Ih] /=.
@@ -163,7 +163,7 @@ Variable exclude : cell -> cell -> Prop.
 Variable close : cell -> cell.
 
 Hypothesis excludeC : forall c1 c2, exclude c1 c2 -> exclude c2 c1.
-Hypothesis exclude_sub : 
+Hypothesis exclude_sub :
   forall c1 c2 c3, exclude c1 c2 -> sub c3 c1 -> exclude c3 c2.
 
 Lemma add_map (s1 : pred cell) (s2 : seq cell) :
@@ -174,7 +174,7 @@ Lemma add_map (s1 : pred cell) (s2 : seq cell) :
     forall c1 c2, c1 = c2 \/ exclude c1 c2}.
 Proof.
 have symcase : forall (s : pred cell) (s' : seq cell),
-  all (predC s) s' -> 
+  all (predC s) s' ->
   {in s', forall c, sub (close c) c} ->
   {in predU s (mem s') &, forall c1 c2, c1 = c2 \/ exclude c1 c2} ->
   forall c1 c2, s c1 -> c2 \in s' -> exclude c1 (close c2).
@@ -243,20 +243,20 @@ Proof. by move=> x. Qed.
 
 Lemma subset_head [T : eqType] [s1 s2 : seq T] [x : T] :
   {subset (x :: s1) <= s2} -> head x s1 \in s2.
-Proof. 
-by move=> sub; apply: sub; case: s1=> [ | a ?] /=; rewrite !inE eqxx ?orbT.
+Proof.
+by move=> Sub; apply: Sub; case: s1=> [ | a ?] /=; rewrite !inE eqxx ?orbT.
 Qed.
 
 End subset_tactic.
 
 Ltac subset_tac :=
-  trivial; 
+  trivial;
   match goal with
   | |- {subset ?x <= ?x} => apply: subset_id
   | |- {subset (_ :: _) <= _} => apply: subset_consl; subset_tac
   | |- {subset (_ ++ _) <= _} => apply: subset_catl; subset_tac
-  | |- {subset _ <= _ ++ _} => 
-     solve[(apply: subset_catrl; subset_tac)] || 
+  | |- {subset _ <= _ ++ _} =>
+     solve[(apply: subset_catrl; subset_tac)] ||
      (apply: subset_catrr; subset_tac)
   | |- {subset _ <= _} =>
     let g := fresh "g" in let gin := fresh "gin" in
diff --git a/theories/pol.v b/theories/pol.v
index 27fa66e..38d585e 100644
--- a/theories/pol.v
+++ b/theories/pol.v
@@ -1,16 +1,15 @@
 From HB Require Import structures.
-From mathcomp Require Import all_ssreflect.
-From mathcomp Require Import ssralg poly ssrnum ssrint rat polyrcf.
+From mathcomp Require Import all_ssreflect archimedean.
+From mathcomp Require Import ssralg poly ssrnum ssrint rat archimedean polyrcf.
 From mathcomp Require Import polyorder polydiv.
 
-(** * Descartes. 
+(** * Descartes.
    polynomials link with the ssr library *)
 (*
 Copyright INRIA (20112012) Marelle Team (Jose Grimm;  Yves Bertot; Assia Mahboubi).
 $Id: pol.v,v 1.35 2012/12/14 11:59:35 grimm Exp $
 *)
 
-
 Set Implicit Arguments.
 Unset Strict Implicit.
 Import Prenex Implicits.
@@ -69,7 +68,7 @@ Proof.  by move=> lta; rewrite mulr_gt0 // invr_gt0 ltr0n. Qed.
 
 Lemma half_ltx x: 0 < x -> half x < x.
 Proof.
-by move=>lta; rewrite ltr_pdivr_mulr ?ltr0n // mulr_natr mulr2n ltrDr.
+by move=>lta; rewrite ltr_pdivrMr ?ltr0n // mulr_natr mulr2n ltrDr.
 Qed.
 
 Lemma double_half x : half x + half x = x.
@@ -96,7 +95,7 @@ Lemma maxS (x y: R) (z := (Num.max x y) +1) : (x<z) && (y <z).
 Proof.
 have p1 : forall u v:R, u <= v -> u < v + 1.
        by move=> u v  h; rewrite (le_lt_trans h) // ltrDl ltr01.
-by rewrite !p1// ?le_maxr// lexx // orbT.
+by rewrite !p1// ?le_max// lexx // orbT.
 Qed.
 
 Lemma pmul2w1 (a b c d : R) : 0 <= a -> 0 <= d -> a <= b -> c <= d ->
@@ -142,7 +141,7 @@ Implicit Types (F: R -> R) (s: seq R) (f g : nat -> R).
 Lemma bigmaxr_ge0 s F: 0 <= \max_(i <- s) F i.
 Proof.
 elim: s; first by rewrite big_nil.
-by move=> s IHs  Hri0; rewrite big_cons le_maxr Hri0 orbT.
+by move=> s IHs  Hri0; rewrite big_cons le_max Hri0 orbT.
 Qed.
 
 Lemma bigmaxr_le s F j:
@@ -150,9 +149,9 @@ Lemma bigmaxr_le s F j:
 Proof.
 elim: s; first by rewrite in_nil.
 move=> i s IHs Hri0; rewrite big_cons.
-case Hi: (j == i); first  by rewrite (eqP Hi) le_maxr lexx.
+case Hi: (j == i); first  by rewrite (eqP Hi) le_max lexx.
 move: Hri0; rewrite in_cons Hi orFb => ins.
-by  apply: le_trans (IHs ins) _; rewrite le_maxr lexx orbT.
+by  apply: le_trans (IHs ins) _; rewrite le_max lexx orbT.
 Qed.
 
 Lemma bigmaxr_le0 s F:
@@ -168,8 +167,8 @@ Lemma bigmaxr_gt0 s F:
   \max_(i <- s) F i > 0 -> { i | i \in s & F i > 0}.
 Proof.
 elim :s => [| a l Hrec]; first by rewrite big_nil ltxx.
-rewrite big_cons lt_maxr.
-case  (ltrP 0 (F a)); first by exists a => //; rewrite in_cons eqxx.
+rewrite big_cons lt_max.
+case (ltrP 0 (F a)); first by exists a => //; rewrite in_cons eqxx.
 rewrite leNgt => /negbTE ->; rewrite orFb => /Hrec [b bl fp0].
 by exists b => //;rewrite in_cons bl orbT.
 Qed.
@@ -227,15 +226,15 @@ Qed.
 Lemma bigmaxf_ge0  f n: 0 <= \max_(i < n) f i.
 Proof.
 elim: n => [| n IHn]; first by rewrite big_ord0.
-by rewrite bigmaxf_rec le_maxr IHn orbT.
+by rewrite bigmaxf_rec le_max IHn orbT.
 Qed.
 
 Lemma bigmaxf_le f n j: (j < n)%N -> f j <= \max_(i < n) f i.
 Proof.
 elim: n => [ //| n IHn]; rewrite bigmaxf_rec.
-case Hi: (j == n); first  by rewrite (eqP Hi) le_maxr lexx.
+case Hi: (j == n); first  by rewrite (eqP Hi) le_max lexx.
 rewrite ltnS leq_eqVlt Hi orFb => aux;apply: (le_trans (IHn aux)).
-by rewrite le_maxr lexx orbT.
+by rewrite le_max lexx orbT.
 Qed.
 
 Lemma bigmaxf_le0 f n: \max_(i < n) f i <= 0 ->
@@ -249,7 +248,7 @@ Lemma bigmaxf_gt0 f n:  \max_(i < n ) f i > 0 -> { i | (i <n)%N  & f i > 0}.
 Proof.
 elim :n => [| a IH]; first by rewrite big_ord0 ltxx.
 case  (ltrP 0 (f a)); first by exists a.
-rewrite bigmaxf_rec lt_maxr leNgt; move /negbTE => ->; rewrite orFb => aux.
+rewrite bigmaxf_rec lt_max leNgt; move /negbTE => ->; rewrite orFb => aux.
 by move: (IH aux) => [b bl fp0]; exists b => //; apply:ltn_trans (ltnSn a).
 Qed.
 
@@ -830,8 +829,8 @@ Qed.
 Lemma CauchyBound1 : `| x | <= 1 + \max_(i < n) (`|E i / E n|).
 Proof.
 move: (bigmaxf_ge0  (fun i => `|E i / E n|) n) => cp.
-case: (lerP `|x| 1)=> cx1; first by rewrite ler_paddr //.
-rewrite addrC -ler_subl_addr.
+case: (lerP `|x| 1)=> cx1; first by rewrite ler_wpDr //.
+rewrite addrC -lerBlDr.
 move: (normr_sumprod (fun i => E i / E n) (fun i =>  x ^+ i) n).
 move: CauchyBound_aux => eq; move: (f_equal (fun z => `| z |) eq).
 rewrite normrN; move => <-;
@@ -843,7 +842,7 @@ move: (sum_powers_of_x (m.+1) `|x|); set aux:= (\sum_(i < m.+1) _) => pa.
 set c := \max_(i < m.+1) `|E i / E m.+1| => cp r1.
 have a1p: 0 < `|x| - 1 by rewrite subr_gt0.
 have r2 : c* aux <= c* ( (`|x| ^+ m.+1) /(`|x| - 1)).
-  by rewrite  (ler_wpM2l cp) // ler_pdivlMr // mulrC pa ger_addl lerN10.
+  by rewrite  (ler_wpM2l cp) // ler_pdivlMr // mulrC pa gerDl lerN10.
 move:  (le_trans r1 r2); rewrite mulrA ler_pdivlMr // mulrC.
 rewrite normrX ler_pM2r //.
 by apply:(lt_trans ltr01); rewrite exprn_egt1.
@@ -902,7 +901,7 @@ Definition norm_pol (p : {poly R}) := map_poly (fun x => `|x|) p.
 Lemma pow_monotone n (x y : R) : 0 <= x <= y ->  0 <= x ^+ n <= y ^+ n.
 Proof.
 move => /andP [xp xy].
-by rewrite ler_expn2r// ?andbT ?exprn_ge0// nnegrE (le_trans _ xy).
+by rewrite lerXn2r// ?andbT ?exprn_ge0// nnegrE (le_trans _ xy).
 Qed.
 
 Lemma diff_xn_ub n (z x y: R): -z  <= x -> x <= y -> y <= z ->
@@ -917,7 +916,7 @@ have l1: 0<=`|x| <=z by rewrite normr_ge0 /= ler_norml zx /= (le_trans xy yz).
 have l2: 0<=`|y| <=z by rewrite normr_ge0 /= ler_norml yz /= (le_trans zx xy).
 have /andP [pa pb] := pow_monotone i l1.
 have /andP [pc pd] := pow_monotone  (n.-1 - i)%N l2.
-by move: (ler_pmul pc pa pd pb); rewrite - exprD subnK //; move: lin; case n.
+by move: (ler_pM pc pa pd pb); rewrite - exprD subnK //; move: lin; case n.
 Qed.
 
 Lemma pol_lip p (z x y: R):  -z <= x -> x <= y -> y <= z ->
@@ -942,8 +941,8 @@ Lemma pol_ucont (p : {poly R}) a b (c := (norm_pol p^`()).[(Num.max (- a) b)]) :
 Proof.
 move => x y ax xy yb.
 apply: pol_lip => //.
-apply: (le_trans _ ax); by rewrite ler_oppl le_maxr lexx.
-apply: (le_trans  yb); by rewrite  le_maxr lexx orbT.
+apply: (le_trans _ ax); by rewrite lerNl le_max lexx.
+apply: (le_trans  yb); by rewrite le_max lexx orbT.
 Qed.
 
 Lemma pol_cont (p : {poly R}) (x eps :R):  0 < eps ->
@@ -958,15 +957,15 @@ have cp: 0<=c.
   move: (hc _ _ pa pb (lexx (x+1))).
   by rewrite  addrAC addrN add0r mulr1; apply: le_trans; rewrite normr_ge0.
 exists (Num.min 1  (eps /(c+1))).
-  rewrite lt_minr ltr01 /= divr_gt0 // ? ep //.
+  rewrite lt_min ltr01 /= divr_gt0 // ? ep //.
   by apply: (lt_le_trans ltr01); move: (lerD2r 1 0 c); rewrite add0r cp.
 move => y.
-rewrite lt_minr; case /andP => xy1 xy2.
+rewrite lt_min; case /andP => xy1 xy2.
 apply: (@le_lt_trans _ _ (c *  `|(y - x)|)); last first.
    move: cp; rewrite le0r; case /orP; first by move /eqP => ->; rewrite mul0r.
    move => cp.
    rewrite -(ltr_pM2l cp) in xy2; apply: (lt_le_trans xy2).
-   rewrite mulrCA  ger_pmulr //.
+   rewrite mulrCA ger_pMr //.
    have c1: c <= c + 1  by move: (lerD2l c 0 1); rewrite ler01 addr0.
    have c1p := (lt_le_trans cp c1).
    by rewrite -(ler_pM2r c1p) mulfVK ? (gt_eqF c1p) // mul1r.
@@ -1041,7 +1040,7 @@ Proof.
 move=> ab nla plb ep.
 move: (pol_ucont p (a:=a) (b:= b)); set c1 := _ .[_ ] => /= pc.
 set c := Num.max 1 c1.
-have lc1: 1 <= c by rewrite le_maxr lexx.
+have lc1: 1 <= c by rewrite le_max lexx.
 have cpos:= (lt_le_trans ltr01 lc1).
 set k := Num.bound ((b - a) * c / eps).
 move: (upper_nthrootP(leqnn k)) => hh.
@@ -1055,15 +1054,15 @@ have hh1: (v-u) * c < eps.
    rewrite mulrAC  -(ltr_pM2r xp) (mulrVK (unitf_gt0 xp)).
    move: hh.
    rewrite -/x.
-   by rewrite ltr_pdivr_mulr// (mulrC _ x).
+   by rewrite ltr_pdivrMr// (mulrC _ x).
 have hh2 : v-u < eps.
   by apply: le_lt_trans hh1; rewrite - {1} (mulr1 (v-u)) (ler_pM2l c2p).
 have dvp: p.[u] < p.[v] by apply (lt_le_trans  pun pvp).
 have hh5: p.[v] - p.[u] <= eps.
   move: (pc _ _ ha (ltW hb) hc);rewrite gtr0_norm ? subr_gt0 // mulrC => hh4.
   apply:(le_trans _ (ltW hh1)); apply: (le_trans hh4).
-  rewrite (ler_pM2l c2p) le_maxr lexx orbT //.
-rewrite eq1 /pair_in_interval pun pvp dvp  (ltW hh2) ler_oppl.
+  rewrite (ler_pM2l c2p) le_max lexx orbT //.
+rewrite eq1 /pair_in_interval pun pvp dvp  (ltW hh2) lerNl.
 rewrite  (le_trans _ hh5) ?(le_trans _ hh5) //.
    by rewrite -{1} (addr0 p.[v]) lerD2l oppr_ge0 ltW.
 by rewrite -{1} (add0r (- p.[u])) lerD2r.
@@ -1097,7 +1096,7 @@ set c := _ .[_ ] => /= pc.
 have cpos : 0 < c.
   rewrite - (ltr_pM2r ba') mul0r.
   by apply: lt_le_trans (pc a b _ _ _) => //; rewrite ? ger0_norm // ltW.
-have pdiv : (0 < (b - a) * c / eps) by rewrite ltr_pdivl_mulr // mul0r mulr_gt0.
+have pdiv : (0 < (b - a) * c / eps) by rewrite ltr_pdivlMr // mul0r mulr_gt0.
 move: (archi_boundP (ltW pdiv)); set n := Num.bound _ => qn.
 have fact1 : (0 : R) < n%:R by exact: lt_trans qn => /=.
 case: n qn fact1 => [|n]; rewrite ?ltxx // => qn _.
@@ -1151,7 +1150,7 @@ have : `|p.[b'] - p.[a']| <= eps.
     rewrite mulrA ler_pdivrMr ?ltr0Sn // mulrC [eps * _]mulrC.
     rewrite -ler_pdivrMr //; apply: (ltW  qn).
 case/ler_normlP => h1 h2.
-rewrite ler_oppl/= !andbT.
+rewrite lerNl/= !andbT.
 rewrite -[in X in X && _](lerD2l p.[b']) (le_trans h2) ? lerDr //.
 by rewrite -(lerD2r (- p.[a'])) (le_trans h2) // lerDl oppr_gte0 ltW.
 Qed.
diff --git a/theories/poly_normal.v b/theories/poly_normal.v
index 326e7cd..92eb380 100644
--- a/theories/poly_normal.v
+++ b/theories/poly_normal.v
@@ -6,7 +6,7 @@ From mathcomp Require Import polyrcf qe_rcf_th complex.
 (*
 This file consists of 3 sections:
 - introduction of normal polynomials, some lemmas on normal polynomials
-- constructions on sequences, such as all_neq0, all_pos, increasing, mid, seqmul, seqn0 
+- constructions on sequences, such as all_neq0, all_pos, increasing, mid, seqmul, seqn0
 - proof of Proposition 2.44 of [bpr], normal_changes
 *)
 (******************************************************************************)
@@ -195,7 +195,7 @@ case/orP : Hrez => [ | Hrez].
   rewrite eq_sym mulf_eq0 oppr_eq0 pnatr_eq0 orFb =>/eqP Hrez.
   rewrite Hrez expr0n mulr0 exprn_even_le0 //= in H.
   by rewrite Hrez (eqP H) expr0n add0r eqxx.
-rewrite Hrez H ltr_spaddl ?orbT // ?lt_def sqr_ge0 // sqrf_eq0.
+rewrite Hrez H ltr_pwDl ?orbT // ?lt_def sqr_ge0 // sqrf_eq0.
 rewrite lt_def mulf_eq0 oppr_eq0 pnatr_eq0 orFb in Hrez.
 by case/andP : Hrez => ->.
 Qed.
@@ -1579,8 +1579,8 @@ apply/increasingP => k Hk.
 rewrite spseq_size in Hk.
 rewrite (@spseq_coef k) //.
   rewrite (@spseq_coef k.+1) //.
-    rewrite ler_sub // ler_pdivr_mulr.
-      rewrite mulrC mulrA ler_pdivl_mulr.
+    rewrite lerB // ler_pdivrMr.
+      rewrite mulrC mulrA ler_pdivlMr.
         by rewrite -expr2 (H3 k.+1).
       rewrite (normal_0notroot_2 Hpnormal Hp0noroot) //.
       by rewrite -(@addn2 k) addnC -ltn_subRL p_size subn2.
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index 3ac1b54..6f65f4b 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -150,10 +150,10 @@ have [vlp vhp] : valid_edge (low c) p /\ valid_edge (high c) p.
   move=> _ /andP[] /andP[] _ /andP[] lh _ /andP[] /andP[] _ /andP[] ll _.
   move=> /andP[] rn0 /andP[] rsx /andP[].
   move=> _ /andP[] /andP[] _ /andP[] _ rl /andP[] _ /andP[] _ rh.
-  rewrite (eqP (allP lsx _ (@last_in_not_nil [eqType of pt] dummy_pt _ ln0))) in ll.
-  rewrite (eqP (allP rsx _ (@head_in_not_nil [eqType of pt] dummy_pt _ rn0))) in rl.
-  rewrite (eqP (allP lsx _ (@head_in_not_nil [eqType of pt] dummy_pt _ ln0))) in lh.
-  rewrite (eqP (allP rsx _ (@last_in_not_nil [eqType of pt] dummy_pt _ rn0))) in rh.
+  rewrite (eqP (allP lsx _ (@last_in_not_nil pt dummy_pt _ ln0))) in ll.
+  rewrite (eqP (allP rsx _ (@head_in_not_nil pt dummy_pt _ rn0))) in rl.
+  rewrite (eqP (allP lsx _ (@head_in_not_nil pt dummy_pt _ ln0))) in lh.
+  rewrite (eqP (allP rsx _ (@last_in_not_nil pt dummy_pt _ rn0))) in rh.
   split; rewrite /valid_edge/generic_trajectories.valid_edge.
     by rewrite (ltW (le_lt_trans ll midl)) (ltW (lt_le_trans midr rl)).
   by rewrite (ltW (le_lt_trans lh midl)) (ltW (lt_le_trans midr rh)).
@@ -174,7 +174,7 @@ by apply: right_limit_right_pt_low_cl.
 Qed.
 
 (* I don't know yet if this is going to be used. *)
-Lemma above_low : 
+Lemma above_low :
   {in closed, forall c p, p === high c -> valid_edge (low c) p ->
      p >>= low c}.
 Proof.
@@ -202,7 +202,7 @@ move=> /andP[] rn0 /andP[] rsx /andP[] srt /andP[] _ lon.
 have p'q : p' = last dummy_pt (right_pts c).
   have := on_edge_same_point p'on lon.
   rewrite (allP rsx _ pin)=> /(_ isT)=> samey.
-  by apply/(@eqP [eqType of pt]); rewrite pt_eqE samey (allP rsx _ pin).
+  by apply/(@eqP pt); rewrite pt_eqE samey (allP rsx _ pin).
 move: rn0 p'q pin srt.
 elim/last_ind: (right_pts c) => [| rpts p2 Ih] // _ p'q pin srt.
 move: pin; rewrite mem_rcons inE => /orP[/eqP -> | pin].
@@ -245,18 +245,18 @@ have p'q : p' = head dummy_pt (left_pts c).
   rewrite (eqP (allP lsx _ pin)).
   rewrite (x_left_pts_left_limit cok (head_in_not_nil _ ln0)) eqxx.
   move=> /(_ isT)=> samey.
-  apply/(@eqP [eqType of pt]); rewrite pt_eqE samey andbT.
+  apply/(@eqP pt); rewrite pt_eqE samey andbT.
   rewrite (eqP (allP lsx _ pin)) eq_sym.
   by rewrite (allP lsx _ (head_in_not_nil _ ln0)).
 move: ln0 p'q pin srt.
 case: (left_pts c)=> [| p2 lpts] // _ p'q pin srt.
-move: pin; rewrite (@in_cons [eqType of pt]) => /orP[/eqP -> | pin].
+move: pin; rewrite (@in_cons pt) => /orP[/eqP -> | pin].
   by rewrite p'q.
 apply: ltW; rewrite p'q.
 move: srt=> /=; rewrite (path_sortedE); last first.
   by move=> x y z xy yz; apply: (lt_trans yz xy).
 move=> /andP[] /allP/(_ (p_y p)) + _; apply.
-by rewrite (@map_f [eqType of pt]).
+by rewrite (@map_f pt).
 Qed.
 
 Lemma safe_cell_interior c p :
@@ -278,7 +278,7 @@ rewrite le_eqVlt=> /orP[ /eqP pxq | ].
     move: lpcc; rewrite /= pxq=> /eqP samex.
     have := on_edge_same_point pong (left_on_edge _).
     rewrite samex=> /(_ isT) samey.
-    by apply/(@eqP [eqType of pt]); rewrite pt_eqE samex samey.
+    by apply/(@eqP pt); rewrite pt_eqE samex samey.
   have pin : p \in points.
     apply: obstacles_point_in; rewrite mem_cat; apply/orP; left.
     by rewrite plg map_f.
@@ -458,11 +458,11 @@ have ln0 : leftmost_points bottom top != [::] :> seq pt.
   rewrite /leftmost_points/generic_trajectories.leftmost_points.
   case: ifP=> [lbl | ltl]; rewrite -/(vertical_intersection_point _ _) pvertE //.
       rewrite R_ltb_lt in lbl.
-      rewrite /valid_edge/generic_trajectories.valid_edge. 
+      rewrite /valid_edge/generic_trajectories.valid_edge.
       by rewrite ltW // ?ltW // (lt_trans ltp).
     by rewrite /no_dup_seq /=; case: ifP=> _.
   move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
-  by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).    
+  by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).
 rewrite ln0 /=.
 have samex : all (fun p => p_x p == left_limit (start_open_cell bottom top))
                (leftmost_points bottom top).
@@ -478,13 +478,13 @@ have samex : all (fun p => p_x p == left_limit (start_open_cell bottom top))
   move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
   rewrite -/(vertical_intersection_point _ _).
   rewrite pvertE; last first.
-    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).    
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).
   set W := (X in no_dup_seq_aux _ X).
   have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
-    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
-  have := (@eq_all_r [eqType of pt] _ _ (@mem_no_dup_seq [eqType of pt] _)).
+    by apply/esym/(@no_dup_seq_aux_eq pt).
+  have := (@eq_all_r pt _ _ (@mem_no_dup_seq pt _)).
   move=> ->.
-  rewrite (@last_no_dup_seq [eqType of pt]).
+  rewrite (@last_no_dup_seq pt).
   by rewrite /W /= !eqxx.
 rewrite samex /=.
 have headin : head dummy_pt (leftmost_points bottom top) === top.
@@ -498,11 +498,11 @@ have headin : head dummy_pt (leftmost_points bottom top) === top.
   move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
   rewrite -/(vertical_intersection_point _ _).
   rewrite pvertE; last first.
-    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp). 
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).
   set W := (X in no_dup_seq_aux _ X).
   have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
-    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
-  rewrite (@head_no_dup_seq [eqType of pt]).
+    by apply/esym/(@no_dup_seq_aux_eq pt).
+  rewrite (@head_no_dup_seq pt).
   rewrite /= pvert_on // /valid_edge/generic_trajectories.valid_edge.
   by rewrite ltl ltW // (lt_trans lbp).
 have lastin : last dummy_pt (leftmost_points bottom top) === bottom.
@@ -516,11 +516,11 @@ have lastin : last dummy_pt (leftmost_points bottom top) === bottom.
   move: ltl=> /negbT; rewrite R_ltb_lt -leNgt=> ltl.
   rewrite -/(vertical_intersection_point _ _).
   rewrite pvertE; last first.
-    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp). 
+    by rewrite /valid_edge/generic_trajectories.valid_edge ltl ltW // (lt_trans lbp).
   set W := (X in no_dup_seq_aux _ X).
   have -> : no_dup_seq_aux (pt_eqb R eq_op) W = no_dup_seq (W : seq pt).
-    by apply/esym/(@no_dup_seq_aux_eq [eqType of pt]).
-  rewrite (@last_no_dup_seq [eqType of pt]).
+    by apply/esym/(@no_dup_seq_aux_eq pt).
+  rewrite (@last_no_dup_seq pt).
   by rewrite /= left_on_edge.
 rewrite headin lastin !andbT.
 have blt : bottom <| top.
@@ -541,10 +541,10 @@ case: ifP => [lbl | ltl].
   have := pvert_on vtb; rewrite abs => lton.
   have lteq : Bpt (p_x (left_pt top))(p_y (left_pt top)) =
         left_pt top.
-    by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+    by apply/(@eqP pt); rewrite pt_eqE /= !eqxx.
   rewrite lteq in lton.
   have [bqt |]: inter_at_ext bottom top by apply: noc0; rewrite !inE eqxx ?orbT.
-    by rewrite bqt lt_irreflexive in lbl.       
+    by rewrite bqt lt_irreflexive in lbl.
   move=> /(_ _ lton (left_on_edge _)); rewrite !inE=> /orP[] /eqP same.
     by rewrite same lt_irreflexive in lbl.
   by have := lt_trans ltp prb; rewrite same lt_irreflexive.
@@ -565,7 +565,7 @@ rewrite le_eqVlt=> /orP[/eqP abs | -> //].
 have := pvert_on vbt; rewrite abs => lton.
 have lteq : Bpt (p_x (left_pt bottom))(p_y (left_pt bottom)) =
         left_pt bottom.
-  by apply/(@eqP [eqType of pt]); rewrite pt_eqE /= !eqxx.
+  by apply/(@eqP pt); rewrite pt_eqE /= !eqxx.
 rewrite -abs lteq in lton.
 have [bqt |]: inter_at_ext top bottom by apply: noc0; rewrite !inE eqxx ?orbT.
   by move: pab; rewrite -bqt under_onVstrict // put orbT.
@@ -590,7 +590,7 @@ move=> /andP[] /andP[] pab put /andP[] /andP[] vb1 vb2 /andP[] vt1 vt2.
 have vb : valid_edge bottom p.
   by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.
 have vt : valid_edge top p.
-  by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.  
+  by rewrite /valid_edge/generic_trajectories.valid_edge !ltW.
 have pub := order_edges_strict_viz_point' vt vb abs put.
 by move: pab; rewrite under_onVstrict // pub orbT.
 Qed.
@@ -615,12 +615,12 @@ move=> g; rewrite events_to_edges_cons mem_cat=> /orP[] gin; last first.
 apply/andP; split; first by rewrite (eqP (out_e g gin)).
 move: close_e=> /allP /(_ g gin).
 move/hasP=> [e2 e2in /eqP ->].
-by apply: (@allP [eqType of pt] _ _ inbox_es); rewrite map_f.
+by apply: (@allP pt _ _ inbox_es); rewrite map_f.
 Qed.
 
 Lemma start_yields_safe_cells evs bottom top (open closed : seq cell):
   sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) evs ->
-  {in [:: bottom, top & 
+  {in [:: bottom, top &
          events_to_edges evs] &, forall e1 e2, inter_at_ext e1 e2} ->
   all (inside_box bottom top) [seq point e | e <- evs] ->
   {in evs, forall ev : event, out_left_event ev} ->
@@ -640,7 +640,7 @@ move=> edges_closed no_event_in_edge outgoing_event_unique start_eq.
 have [e0 e0in] : exists e, e \in evs.
   by case: (evs) evsn0 => [ | a ?] //; exists a; rewrite mem_head.
 have inbox_e : inside_box bottom top (point e0).
-  by apply: (@allP [eqType of pt] _ _ all_points_in); rewrite map_f.
+  by apply: (@allP pt _ _ all_points_in); rewrite map_f.
 have noc0 : {in [:: bottom; top] &, forall g1 g2, inter_at_ext g1 g2}.
   move=> g1 g2 g1in g2in.
   by apply: no_crossing; rewrite -[_ :: _]/([:: _; _] ++ _) mem_cat ?g1in ?g2in.

From 11fd6bac012a99f7aa0a908fa4573443201f4986 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Tue, 23 Apr 2024 10:14:46 +0900
Subject: [PATCH 12/43] rename html -> www so that Coq's makefile does not
 clean it

---
 .gitignore                  |   8 +-
 www/Add.html                |  30 +++
 www/Add.ml                  | 403 ++++++++++++++++++++++++++++++++
 www/AddScript.js            |   4 +
 www/Makefile                |  11 +
 www/Makefile.coq.local      |  62 +++++
 www/add.v                   |  14 ++
 www/curve.html              |  27 +++
 www/grid.html               |  46 ++++
 www/grid.js                 | 446 ++++++++++++++++++++++++++++++++++++
 www/jAdd.ml                 |  57 +++++
 www/jAdd.mli                |   6 +
 www/jSmoothTrajectories.ml  | 137 +++++++++++
 www/jSmoothTrajectories.mli |   6 +
 www/script.js               | 171 ++++++++++++++
 15 files changed, 1424 insertions(+), 4 deletions(-)
 create mode 100755 www/Add.html
 create mode 100644 www/Add.ml
 create mode 100644 www/AddScript.js
 create mode 100644 www/Makefile
 create mode 100644 www/Makefile.coq.local
 create mode 100644 www/add.v
 create mode 100755 www/curve.html
 create mode 100755 www/grid.html
 create mode 100644 www/grid.js
 create mode 100644 www/jAdd.ml
 create mode 100644 www/jAdd.mli
 create mode 100644 www/jSmoothTrajectories.ml
 create mode 100644 www/jSmoothTrajectories.mli
 create mode 100644 www/script.js

diff --git a/.gitignore b/.gitignore
index c4e0fb6..1935569 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,7 +8,7 @@
 Makefile.coq
 Makefile.coq.conf
 .Makefile.coq.d
-html/*.cmo
-html/*.cmi
-html/*.bytes
-html/*.js
\ No newline at end of file
+www/*.cmo
+www/*.cmi
+www/*.bytes
+www/*.js
diff --git a/www/Add.html b/www/Add.html
new file mode 100755
index 0000000..aefc4fa
--- /dev/null
+++ b/www/Add.html
@@ -0,0 +1,30 @@
+
+
+<HTML>
+
+    <HEAD>
+
+        <TITLE>Add</TITLE>
+
+    </HEAD><BODY>
+
+        <H1> Add </H1>
+       
+        <p>
+	        <script src="Add.js"></script>
+	        <script src="AddScript.js"></script>
+  </div>
+  <div>
+    <textarea id="text" name="text"
+          rows="1" cols="33">
+1 2 1 2 
+</textarea>
+<p>
+  <button onclick="myadd()" class="Clear"> Test </button>
+ </div>
+</div>
+        </p>
+
+    </BODY>
+
+</HTML>
diff --git a/www/Add.ml b/www/Add.ml
new file mode 100644
index 0000000..c94be3b
--- /dev/null
+++ b/www/Add.ml
@@ -0,0 +1,403 @@
+
+type nat =
+| O
+| S of nat
+
+type ('a, 'b) prod =
+| Pair of 'a * 'b
+
+(** val snd : ('a1, 'a2) prod -> 'a2 **)
+
+let snd = function
+| Pair (_, y) -> y
+
+type 'a list =
+| Nil
+| Cons of 'a * 'a list
+
+type comparison =
+| Eq
+| Lt
+| Gt
+
+module Coq__1 = struct
+ (** val add : nat -> nat -> nat **)
+ let rec add n m =
+   match n with
+   | O -> m
+   | S p -> S (add p m)
+end
+include Coq__1
+
+type positive =
+| XI of positive
+| XO of positive
+| XH
+
+type z =
+| Z0
+| Zpos of positive
+| Zneg of positive
+
+module Pos =
+ struct
+  type mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+ end
+
+module Coq_Pos =
+ struct
+  (** val succ : positive -> positive **)
+
+  let rec succ = function
+  | XI p -> XO (succ p)
+  | XO p -> XI p
+  | XH -> XO XH
+
+  (** val add : positive -> positive -> positive **)
+
+  let rec add x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> XO (add_carry p q0)
+       | XO q0 -> XI (add p q0)
+       | XH -> XO (succ p))
+    | XO p ->
+      (match y with
+       | XI q0 -> XI (add p q0)
+       | XO q0 -> XO (add p q0)
+       | XH -> XI p)
+    | XH -> (match y with
+             | XI q0 -> XO (succ q0)
+             | XO q0 -> XI q0
+             | XH -> XO XH)
+
+  (** val add_carry : positive -> positive -> positive **)
+
+  and add_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> XI (add_carry p q0)
+       | XO q0 -> XO (add_carry p q0)
+       | XH -> XI (succ p))
+    | XO p ->
+      (match y with
+       | XI q0 -> XO (add_carry p q0)
+       | XO q0 -> XI (add p q0)
+       | XH -> XO (succ p))
+    | XH ->
+      (match y with
+       | XI q0 -> XI (succ q0)
+       | XO q0 -> XO (succ q0)
+       | XH -> XI XH)
+
+  (** val pred_double : positive -> positive **)
+
+  let rec pred_double = function
+  | XI p -> XI (XO p)
+  | XO p -> XI (pred_double p)
+  | XH -> XH
+
+  type mask = Pos.mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+
+  (** val succ_double_mask : mask -> mask **)
+
+  let succ_double_mask = function
+  | IsNul -> IsPos XH
+  | IsPos p -> IsPos (XI p)
+  | IsNeg -> IsNeg
+
+  (** val double_mask : mask -> mask **)
+
+  let double_mask = function
+  | IsPos p -> IsPos (XO p)
+  | x0 -> x0
+
+  (** val double_pred_mask : positive -> mask **)
+
+  let double_pred_mask = function
+  | XI p -> IsPos (XO (XO p))
+  | XO p -> IsPos (XO (pred_double p))
+  | XH -> IsNul
+
+  (** val sub_mask : positive -> positive -> mask **)
+
+  let rec sub_mask x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> double_mask (sub_mask p q0)
+       | XO q0 -> succ_double_mask (sub_mask p q0)
+       | XH -> IsPos (XO p))
+    | XO p ->
+      (match y with
+       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
+       | XO q0 -> double_mask (sub_mask p q0)
+       | XH -> IsPos (pred_double p))
+    | XH -> (match y with
+             | XH -> IsNul
+             | _ -> IsNeg)
+
+  (** val sub_mask_carry : positive -> positive -> mask **)
+
+  and sub_mask_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
+       | XO q0 -> double_mask (sub_mask p q0)
+       | XH -> IsPos (pred_double p))
+    | XO p ->
+      (match y with
+       | XI q0 -> double_mask (sub_mask_carry p q0)
+       | XO q0 -> succ_double_mask (sub_mask_carry p q0)
+       | XH -> double_pred_mask p)
+    | XH -> IsNeg
+
+  (** val sub : positive -> positive -> positive **)
+
+  let sub x y =
+    match sub_mask x y with
+    | IsPos z0 -> z0
+    | _ -> XH
+
+  (** val mul : positive -> positive -> positive **)
+
+  let rec mul x y =
+    match x with
+    | XI p -> add y (XO (mul p y))
+    | XO p -> XO (mul p y)
+    | XH -> y
+
+  (** val size_nat : positive -> nat **)
+
+  let rec size_nat = function
+  | XI p0 -> S (size_nat p0)
+  | XO p0 -> S (size_nat p0)
+  | XH -> S O
+
+  (** val compare_cont : comparison -> positive -> positive -> comparison **)
+
+  let rec compare_cont r x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> compare_cont r p q0
+       | XO q0 -> compare_cont Gt p q0
+       | XH -> Gt)
+    | XO p ->
+      (match y with
+       | XI q0 -> compare_cont Lt p q0
+       | XO q0 -> compare_cont r p q0
+       | XH -> Gt)
+    | XH -> (match y with
+             | XH -> r
+             | _ -> Lt)
+
+  (** val compare : positive -> positive -> comparison **)
+
+  let compare =
+    compare_cont Eq
+
+  (** val ggcdn :
+      nat -> positive -> positive -> (positive, (positive, positive) prod)
+      prod **)
+
+  let rec ggcdn n a b =
+    match n with
+    | O -> Pair (XH, (Pair (a, b)))
+    | S n0 ->
+      (match a with
+       | XI a' ->
+         (match b with
+          | XI b' ->
+            (match compare a' b' with
+             | Eq -> Pair (a, (Pair (XH, XH)))
+             | Lt ->
+               let Pair (g, p) = ggcdn n0 (sub b' a') a in
+               let Pair (ba, aa) = p in
+               Pair (g, (Pair (aa, (add aa (XO ba)))))
+             | Gt ->
+               let Pair (g, p) = ggcdn n0 (sub a' b') b in
+               let Pair (ab, bb) = p in
+               Pair (g, (Pair ((add bb (XO ab)), bb))))
+          | XO b0 ->
+            let Pair (g, p) = ggcdn n0 a b0 in
+            let Pair (aa, bb) = p in Pair (g, (Pair (aa, (XO bb))))
+          | XH -> Pair (XH, (Pair (a, XH))))
+       | XO a0 ->
+         (match b with
+          | XI _ ->
+            let Pair (g, p) = ggcdn n0 a0 b in
+            let Pair (aa, bb) = p in Pair (g, (Pair ((XO aa), bb)))
+          | XO b0 -> let Pair (g, p) = ggcdn n0 a0 b0 in Pair ((XO g), p)
+          | XH -> Pair (XH, (Pair (a, XH))))
+       | XH -> Pair (XH, (Pair (XH, b))))
+
+  (** val ggcd :
+      positive -> positive -> (positive, (positive, positive) prod) prod **)
+
+  let ggcd a b =
+    ggcdn (Coq__1.add (size_nat a) (size_nat b)) a b
+ end
+
+module Z =
+ struct
+  (** val double : z -> z **)
+
+  let double = function
+  | Z0 -> Z0
+  | Zpos p -> Zpos (XO p)
+  | Zneg p -> Zneg (XO p)
+
+  (** val succ_double : z -> z **)
+
+  let succ_double = function
+  | Z0 -> Zpos XH
+  | Zpos p -> Zpos (XI p)
+  | Zneg p -> Zneg (Coq_Pos.pred_double p)
+
+  (** val pred_double : z -> z **)
+
+  let pred_double = function
+  | Z0 -> Zneg XH
+  | Zpos p -> Zpos (Coq_Pos.pred_double p)
+  | Zneg p -> Zneg (XI p)
+
+  (** val pos_sub : positive -> positive -> z **)
+
+  let rec pos_sub x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q0 -> double (pos_sub p q0)
+       | XO q0 -> succ_double (pos_sub p q0)
+       | XH -> Zpos (XO p))
+    | XO p ->
+      (match y with
+       | XI q0 -> pred_double (pos_sub p q0)
+       | XO q0 -> double (pos_sub p q0)
+       | XH -> Zpos (Coq_Pos.pred_double p))
+    | XH ->
+      (match y with
+       | XI q0 -> Zneg (XO q0)
+       | XO q0 -> Zneg (Coq_Pos.pred_double q0)
+       | XH -> Z0)
+
+  (** val add : z -> z -> z **)
+
+  let add x y =
+    match x with
+    | Z0 -> y
+    | Zpos x' ->
+      (match y with
+       | Z0 -> x
+       | Zpos y' -> Zpos (Coq_Pos.add x' y')
+       | Zneg y' -> pos_sub x' y')
+    | Zneg x' ->
+      (match y with
+       | Z0 -> x
+       | Zpos y' -> pos_sub y' x'
+       | Zneg y' -> Zneg (Coq_Pos.add x' y'))
+
+  (** val mul : z -> z -> z **)
+
+  let mul x y =
+    match x with
+    | Z0 -> Z0
+    | Zpos x' ->
+      (match y with
+       | Z0 -> Z0
+       | Zpos y' -> Zpos (Coq_Pos.mul x' y')
+       | Zneg y' -> Zneg (Coq_Pos.mul x' y'))
+    | Zneg x' ->
+      (match y with
+       | Z0 -> Z0
+       | Zpos y' -> Zneg (Coq_Pos.mul x' y')
+       | Zneg y' -> Zpos (Coq_Pos.mul x' y'))
+
+  (** val sgn : z -> z **)
+
+  let sgn = function
+  | Z0 -> Z0
+  | Zpos _ -> Zpos XH
+  | Zneg _ -> Zneg XH
+
+  (** val abs : z -> z **)
+
+  let abs = function
+  | Zneg p -> Zpos p
+  | x -> x
+
+  (** val to_pos : z -> positive **)
+
+  let to_pos = function
+  | Zpos p -> p
+  | _ -> XH
+
+  (** val ggcd : z -> z -> (z, (z, z) prod) prod **)
+
+  let ggcd a b =
+    match a with
+    | Z0 -> Pair ((abs b), (Pair (Z0, (sgn b))))
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
+       | Zpos b0 ->
+         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
+         let Pair (aa, bb) = p in
+         Pair ((Zpos g), (Pair ((Zpos aa), (Zpos bb))))
+       | Zneg b0 ->
+         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
+         let Pair (aa, bb) = p in
+         Pair ((Zpos g), (Pair ((Zpos aa), (Zneg bb)))))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
+       | Zpos b0 ->
+         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
+         let Pair (aa, bb) = p in
+         Pair ((Zpos g), (Pair ((Zneg aa), (Zpos bb))))
+       | Zneg b0 ->
+         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
+         let Pair (aa, bb) = p in
+         Pair ((Zpos g), (Pair ((Zneg aa), (Zneg bb)))))
+ end
+
+type q = { qnum : z; qden : positive }
+
+(** val qplus : q -> q -> q **)
+
+let qplus x y =
+  { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
+    qden = (Coq_Pos.mul x.qden y.qden) }
+
+(** val qred : q -> q **)
+
+let qred q0 =
+  let { qnum = q1; qden = q2 } = q0 in
+  let Pair (r1, r2) = snd (Z.ggcd q1 (Zpos q2)) in
+  { qnum = r1; qden = (Z.to_pos r2) }
+
+(** val a_val : q list **)
+
+let a_val =
+  Cons ({ qnum = (Zpos XH); qden = XH }, Nil)
+
+(** val sum_val_rec : q list -> q **)
+
+let rec sum_val_rec = function
+| Nil -> { qnum = Z0; qden = XH }
+| Cons (a, l0) -> qred (qplus a (sum_val_rec l0))
+
+(** val sum_val : q list -> q list **)
+
+let sum_val l =
+  Cons ((sum_val_rec l), Nil)
diff --git a/www/AddScript.js b/www/AddScript.js
new file mode 100644
index 0000000..eee5860
--- /dev/null
+++ b/www/AddScript.js
@@ -0,0 +1,4 @@
+function myadd() {
+  let v = document.getElementById("text").value;
+ window.alert(add(v));
+}
diff --git a/www/Makefile b/www/Makefile
new file mode 100644
index 0000000..07218d0
--- /dev/null
+++ b/www/Makefile
@@ -0,0 +1,11 @@
+all: Makefile.coq
+	make -f Makefile.coq
+
+Makefile.coq:
+	coq_makefile *.v -o Makefile.coq
+
+run:
+	python3 -m http.server
+
+clean:
+	make -f Makefile.coq clean
\ No newline at end of file
diff --git a/www/Makefile.coq.local b/www/Makefile.coq.local
new file mode 100644
index 0000000..7083bfd
--- /dev/null
+++ b/www/Makefile.coq.local
@@ -0,0 +1,62 @@
+post-all::
+	$(MAKE) -f $(SELF) Add.mli SmoothTrajectories.mli
+clean::
+	rm -f Add.mli
+
+Add.mli : add.vo
+	echo "mli"
+post-all::
+		$(MAKE) -f $(SELF) Add.ml
+clean::
+		rm -f Add.ml
+Add.ml : add.vo
+		echo "ml"
+
+post-all::
+	$(MAKE) -f $(SELF) Add.cmi SmoothTrajectories.cmi
+
+clean::
+	rm -f Add.cmi Add.cmo jAdd.cmi jAdd.cmo SmoothTrajectories.cmi SmoothTrajectories.cmo jSmoothTrajectories.cmi jSmoothTrajectories.cmo
+
+Add.cmi : Add.mli
+	ocamlfind ocamlc Add.mli
+
+SmoothTrajectories.ml SmoothTrajectories.mli : ../theories/smooth_trajectories.vo
+	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
+	cp ../theories/SmoothTrajectories.ml ../theories/SmoothTrajectories.mli .
+
+SmoothTrajectories.cmi : SmoothTrajectories.mli
+	ocamlfind ocamlc SmoothTrajectories.mli
+
+post-all::
+	$(MAKE) -f $(SELF) jAdd.cmi jSmoothTrajectories.cmi
+clean::
+	rm -f jAdd.cmi jSmoothTrajectories.cmi
+
+jAdd.cmi :  jAdd.ml
+	ocamlfind ocamlc jAdd.mli
+
+jSmoothTrajectories.cmi :  jSmoothTrajectories.ml
+	ocamlfind ocamlc jSmoothTrajectories.mli
+
+post-all::
+	$(MAKE) -f $(SELF) Add.bytes SmoothTrajectories.bytes
+clean::
+	rm -f Add.bytes SmoothTrajectories.bytes
+
+Add.bytes :  jAdd.cmi jAdd.ml Add.ml Add.cmi
+	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o Add.bytes Add.ml jAdd.ml
+
+SmoothTrajectories.bytes :  jSmoothTrajectories.cmi jSmoothTrajectories.ml SmoothTrajectories.ml SmoothTrajectories.cmi
+	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o SmoothTrajectories.bytes SmoothTrajectories.ml jSmoothTrajectories.ml
+
+post-all::
+	$(MAKE) -f $(SELF) Add.js SmoothTrajectories.js
+clean::
+	rm -f Add.js SmoothTrajectories.js
+
+Add.js :  Add.bytes
+	js_of_ocaml Add.bytes
+
+SmoothTrajectories.js :  SmoothTrajectories.bytes
+	js_of_ocaml --opt=3 SmoothTrajectories.bytes
diff --git a/www/add.v b/www/add.v
new file mode 100644
index 0000000..0d36de6
--- /dev/null
+++ b/www/add.v
@@ -0,0 +1,14 @@
+Require Import List QArith Extraction.
+
+
+Definition a_val := 1%Q :: nil.
+
+Fixpoint sum_val_rec l :=
+ match l with a :: l =>     Qred (a + sum_val_rec l)%Q | _ => 0%Q end.
+
+Definition sum_val l := (sum_val_rec l) :: nil.
+
+Compute sum_val ((1#2)%Q :: (1#2)%Q :: nil).
+
+Extraction "Add.ml" a_val sum_val.
+
diff --git a/www/curve.html b/www/curve.html
new file mode 100755
index 0000000..6de55e6
--- /dev/null
+++ b/www/curve.html
@@ -0,0 +1,27 @@
+<html>
+	<head>
+		<meta charset="utf-8">
+		<title>Curve</title>
+    <style>
+      body {
+              overflow: hidden;
+              margin: 0px;
+           }
+    </style>
+    <script async
+      src="https://unpkg.com/es-module-shims@1.6.3/dist/es-module-shims.js">
+    </script>
+
+    <script type="importmap">
+      {
+        "imports": {
+        "three": "https://unpkg.com/three@0.150.1/build/three.module.js",
+        "three/addons/": "https://unpkg.com/three@0.150.1/examples/jsm/"
+        }
+      }
+    </script>
+	</head>
+  <body>
+  <script defer type="module" src="./script.js"></script>
+  </body>
+</html>
\ No newline at end of file
diff --git a/www/grid.html b/www/grid.html
new file mode 100755
index 0000000..118df43
--- /dev/null
+++ b/www/grid.html
@@ -0,0 +1,46 @@
+<html>
+	<head>
+		<meta charset="utf-8">
+		<title>Grid</title>
+    <style>
+      body {
+              overflow: hidden;
+              margin: 0px;
+           }
+    </style>
+    <script async
+      src="https://unpkg.com/es-module-shims@1.6.3/dist/es-module-shims.js">
+    </script>
+
+    <script type="importmap">
+      {
+        "imports": {
+        "three": "https://unpkg.com/three@0.150.1/build/three.module.js",
+        "three/addons/": "https://unpkg.com/three@0.150.1/examples/jsm/"
+        }
+      }
+    </script>
+	</head>
+  <body>
+<input type="radio" id="obstacles" name="modality" value="obstacles" checked="checked">
+<label for="Maze">Obstacles</label>
+<input type="radio" id="positions" name="modality" value="positions">
+<label for="Position">Starting and ending positions</label> 
+<input type="checkbox" id="cell" name="Show Cells">
+<label> Show Cells </label>
+<p>
+  To add an obstacle, click to a first end-point (blue square)
+  then click to the second end-point
+<p>
+  To remove an obstacle, click to a first end-point (blue square)
+  then click to the second end-point
+<p>
+  After giving the starting point and the ending point (positions) the system 
+  gives a path avoiding the obstacles.
+<p> 
+  To see the cells used by the algorithm, tick the Show Cell check-box
+</p>
+  <script defer type="module" src="./SmoothTrajectories.js"></script>
+  <script defer type="module" src="./grid.js"></script>
+  </body>
+</html>
\ No newline at end of file
diff --git a/www/grid.js b/www/grid.js
new file mode 100644
index 0000000..7281805
--- /dev/null
+++ b/www/grid.js
@@ -0,0 +1,446 @@
+import * as THREE from 'three';
+
+/* Size of the grid */
+const gSize  = 40;
+
+/* The render */
+const renderer = new THREE.WebGLRenderer();
+renderer.setSize(600, 600);
+document.body.insertBefore(renderer.domElement, document.body.firstChild);
+
+/* The camera */
+const camera = new THREE.PerspectiveCamera( 45, 1, 1, 500 );
+camera.position.set(0, 1.5 * gSize, 0);
+camera.lookAt( 0, 0, 0 );
+
+/* The scene */
+var scene = new THREE.Scene();
+scene.background = new THREE.Color( 'lightgrey' );
+
+/* The grid */
+var grid = new THREE.GridHelper(gSize, gSize);
+scene.add(grid);
+grid.position.z = 0;
+grid.position.y = 0.1;
+grid.position.x = 0;
+renderer.render( scene, camera );
+
+/* The board */
+const boardColor = new THREE.Color('white');
+const boardMat   = new THREE.MeshBasicMaterial({color: boardColor});
+const boardGeometry = new THREE.BoxGeometry(gSize,0.1, gSize);
+const boardCube = new THREE.Mesh(boardGeometry, boardMat);
+boardCube.position.z = 0;
+boardCube.position.y = 0;
+boardCube.position.x = 0;
+scene.add(boardCube);
+
+/* The From Square */
+var fromValid = false;
+var fromX = 0;
+var fromY = 0.2;
+var fromZ = 0;
+const fromColor = new THREE.Color('blue');
+const fromMat   = new THREE.MeshBasicMaterial({color: fromColor});
+// create the from Square
+const fromGeometry = new THREE.BoxGeometry(0.9, 0.1, 0.9);
+const fromCube = new THREE.Mesh(fromGeometry, fromMat);
+// The initial position
+fromCube.position.z = fromZ;
+fromCube.position.y = -0.2;
+fromCube.position.x = fromX;
+scene.add(fromCube);
+
+/* The To Square */
+var toValid = false;
+var fY = 0.2;
+var tY = 0.2;
+var toX = 0;
+var toY = 0.2;
+var toZ = 0;
+var toColor = new THREE.Color('red');
+const toMat   = new THREE.MeshBasicMaterial({color: toColor});
+// create the to Square
+const toGeometry = new THREE.BoxGeometry(0.9, 0.1, 0.9);
+const toCube = new THREE.Mesh(toGeometry, toMat);
+// The initial position
+toCube.position.z = toZ;
+toCube.position.y = -0.2;
+toCube.position.x = toX;
+scene.add(toCube);
+renderer.render( scene, camera );
+
+// The Borders 
+var  borders = [];
+borders.push({fX : - gSize/2, fZ : - gSize/2, tX : gSize/2, tZ : - gSize/2});
+borders.push({fX : - gSize/2, fZ :   gSize/2, tX : gSize/2, tZ :   gSize/2});
+
+// The obstacles 
+var  obstacles = [];
+const lineColor = new THREE.Color( 'green' );
+const lineMat = new THREE.LineBasicMaterial({color: lineColor, linewidth: 1});
+
+function addObstacle(fX, fZ, tX, tZ) {
+    if (tX < fX) {
+        let xX = fX;
+        let xZ = fZ;
+        fX = tX;
+        fZ = tZ;
+        tX = xX;
+        tZ = xZ;
+    }
+    console.log("addObstacle " + fX + " " + fZ + " " + tX + " " + tZ);
+    fromValid = false;  
+    toValid = false;   
+    fromCube.position.y = -0.2;
+    toCube.position.y = -0.2;
+    let test = false;
+    let index = 0;
+    let tline = null;
+    obstacles.every(item => {
+            if ((fX == item.fX) && (fZ == item.fZ) &&
+                (tX == item.tX) && (tZ == item.tZ)) {
+                test = true;
+                tline = item.line;
+                return false;
+            };
+            index++;
+            return true;
+    });
+    if (test) {
+        console.log("delete");
+        scene.remove(tline);
+        obstacles.splice(index, 1);
+        renderer.render( scene, camera ); 
+        cleanCells();
+        getCells();
+        return;
+    }
+    let fromVector = new THREE.Vector3(fX, fY, fZ ) ;
+    console.log(fromVector + "" + fX + " " + fY + " " + fZ);    
+    let toVector = new THREE.Vector3(tX, tY, tZ ) ;
+    console.log(toVector + "" + tX + " " + tY + " " + tZ);    
+    let points = [fromVector, toVector];
+    let geometry = new THREE.BufferGeometry().setFromPoints( points );
+    let vline = new THREE.Line( geometry, lineMat );
+    scene.add( vline );
+    const v = {fX : fX, fZ : fZ, tX : tX, tZ : tZ, line : vline };
+    obstacles.push(v);
+    renderer.render( scene, camera );
+    cleanCells();
+    getCells();     
+}
+
+
+/* The cells */
+var cells = [];
+var cellsFlag = true;
+
+const cellsButtons = 
+  document.querySelectorAll('input[name="Show Cells"]');
+
+for (const cellsButton of cellsButtons) {
+    cellsButton.addEventListener("click", setCells, false);
+}
+
+
+const dmaterial = new THREE.LineDashedMaterial( {
+	color: 'black',
+	dashSize: 0.4,
+	gapSize: 0.4,
+} );
+
+
+// Function to output a value v
+function outVal (v) {
+    let v1 = v + 0.5 + (gSize/2);
+    let val = "+" + (2 * v1) + " " + "+" + (2 * gSize) + " "
+    return val;
+}
+
+function getCells() {
+  if (!cellsFlag) {
+    return;
+  }
+  let val = "";
+  if (borders.length != 2) {
+    return;
+  }
+  if (borders[0].fZ <= borders[1].fZ) {
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+  } else {
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+  }
+  for (const obstacle of obstacles) {
+    val += outVal(obstacle.fX) + outVal(obstacle.fZ)
+            + outVal(obstacle.tX) + outVal(obstacle.tZ);  
+  } 
+  console.log("boarders " + borders.length + " obstacles " + obstacles.length);
+  console.log("val " + val);
+  let res = ocamlLib.cells(val);
+  console.log("res " + res);
+  let res1 = res.split(' ').map(Number);
+  console.log("res1 length" + res1.length);
+  console.log("res1[0]=" + res1[0]);
+  console.log("res1[res1.length - 1]=" + res1[res1.length - 1]);
+  let i = 0;
+  while (i < res1.length - 1) {
+    /* Straight line */
+    let fx = res1[i] / res1 [i + 1] * gSize - 0.5 - gSize/2;
+    let fy = 0.3;
+    let fz = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
+    let tx = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
+    let ty = 0.3;
+    let tz = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
+    console.log("Adding a dotted line" + fx + " " + fz + " " + tx + " " + tz);
+    let epoints = [];
+     epoints.push( new THREE.Vector3(fx, fy, fz) );
+     epoints.push( new THREE.Vector3(tx, ty, tz));
+    let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
+    let sline = new THREE.Line( egeometry, dmaterial );
+    sline.computeLineDistances();
+    cells.push(sline);
+    scene.add( sline );
+    renderer.render( scene, camera );
+    i += 8;
+  }
+}
+
+function cleanCells () {
+    let i = 0; 
+    console.log("cells " + cells);
+    while (i < cells.length)
+    for (const cell of cells) {
+        scene.remove(cells[i]);
+        i++;
+    }
+    renderer.render( scene, camera ); 
+    cells = [];
+}
+
+function setCells() {
+    cleanCells();
+    cellsFlag = cellsButtons[0].checked;
+    if (cellsFlag) {
+      scene.remove(grid)
+    } else {
+      scene.add(grid);
+    }
+    renderer.render( scene, camera );
+    getCells();
+}
+
+setCells();
+
+/* The curve */
+
+var curves = [];
+const cmaterial = new THREE.LineBasicMaterial( { color: 'brown' } );
+
+function cleanCurve () {
+    let i = 0; 
+    console.log("curves " + curves);
+    while (i < curves.length)
+    for (const curve of curves) {
+        scene.remove(curve);
+        i++;
+    }
+    renderer.render( scene, camera ); 
+    curves = [];
+}
+
+function getCurve() {
+  let val = "";
+  val += outVal(positions.fX) + outVal(positions.fZ) + 
+         outVal(positions.tX) + outVal(positions.tZ);
+  if (borders.length != 2) {
+    return;
+  }
+  if (borders[0].fZ <= borders[1].fZ) {
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+  } else {
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+  }
+  for (const obstacle of obstacles) {
+    val += outVal(obstacle.fX) + outVal(obstacle.fZ)
+            + outVal(obstacle.tX) + outVal(obstacle.tZ);  
+  } 
+  console.log("boarders " + borders.length + " obstacles " + obstacles.length);
+  console.log("val " + val);
+  let res = ocamlLib.smooth(val);
+  console.log("res " + res);
+  let res1 = res.split(' ').map(Number);
+  let i = 0;
+  while (i < res1.length) {
+    if (res1[i] == 1) {
+        /* Straight line */
+        let fx = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
+        let fy = 0.3;
+        let fz = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
+        let tx = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
+        let ty = 0.3;
+        let tz = res1[i + 8] / res1 [i + 9] * gSize - 0.5 - gSize/2;
+        console.log("Adding a line" + fx + " " + fz + " " + tx + " " + tz);
+        let epoints = [];
+        epoints.push( new THREE.Vector3(fx, fy, fz) );
+        epoints.push( new THREE.Vector3(tx, ty, tz));
+        let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
+        let sline = new THREE.Line( egeometry, cmaterial );
+        curves.push(sline);
+        scene.add( sline );
+        renderer.render( scene, camera );
+        i += 10;
+    } else if (res1[i] == 2) {
+        /* curve */
+        let fx = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
+        let fy = 0.3;
+        let fz = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
+        let cx = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
+        let cy = 0.3;
+        let cz = res1[i + 8] / res1 [i + 9] * gSize - 0.5 - gSize/2;
+        let tx = res1[i + 10] / res1 [i + 11] * gSize - 0.5 - gSize/2;
+        let ty = 0.3;
+        let tz = res1[i + 12] / res1 [i + 13] * gSize - 0.5 - gSize/2;
+        console.log("Adding a curve" + fx + " " + fz + " " 
+                                     + cx + " " + cz + " " + tx + " " + tz);
+        let ccurve = new THREE.QuadraticBezierCurve3(
+                	new THREE.Vector3(fx, fy, fz ),
+	                new THREE.Vector3(cx, cy, cz ),
+	                new THREE.Vector3(tx, ty, tz )
+                );
+        let cpoints = ccurve.getPoints( 50 );
+        let cgeometry = new THREE.BufferGeometry().setFromPoints( cpoints );
+        let cline = new THREE.Line( cgeometry, cmaterial );
+        scene.add( cline );
+        curves.push(cline);
+        i += 14;
+    } else {
+        i++;
+    }
+  }
+}
+
+
+/* The modality */
+
+var modality = "";
+
+const radioButtons = 
+  document.querySelectorAll('input[name="modality"]');
+
+for (const radioButton of radioButtons) {
+    radioButton.addEventListener("click", setModality, false);
+}
+
+function setModality() {
+    cleanCurve();
+    fromValid = false;  
+    toValid = false;         
+    fromCube.position.y = -0.2;
+    toCube.position.y = -0.2;
+    renderer.render( scene, camera );        
+    for (const radioButton of radioButtons) {
+        if (radioButton.checked) {
+            modality = radioButton.value;
+            console.log("new modality " + modality);
+            break;
+        }
+    }
+}
+ 
+setModality();
+
+
+/* The mouse */
+var mouse = new THREE.Vector2();
+var raycaster = new THREE.Raycaster();
+renderer.domElement.addEventListener('click', onDocumentMouseDown, false);
+// store the from and to position 
+var positions;
+
+function onDocumentMouseDown( event ) {
+
+    // Get screen-space x/y
+    mouse.x = ( event.clientX / renderer.domElement.clientWidth ) * 2 - 1;
+    mouse.y = - ( event.clientY / renderer.domElement.clientHeight ) * 2 + 1;
+
+    // Perform raycast
+    raycaster.setFromCamera( mouse, camera );
+
+    // See if the ray from the camera into the world hits our mesh
+    const intersects = raycaster.intersectObject( boardCube );
+
+    // Check if an intersection took place
+    if ( intersects.length == 0 ) {
+        return;
+    }
+    let posX = intersects[0].point.x;
+    let posZ = intersects[0].point.z;
+    let dZ = Math.abs(Math.trunc(posZ) - posZ);
+    let dX = Math.abs(Math.trunc(posX) - posX);
+/*    if (((dZ < 0.05) || (0.95 < dZ)) || (dX < 0.05) || (0.95 < dX)) {
+        return;
+    }
+*/
+    if (toValid && (modality == "positions")) {
+        fromValid = false;
+        toValid = false;
+        fromCube.position.y = -0.2;
+        toCube.position.y = -0.2;
+        cleanCurve();
+        renderer.render( scene, camera );  
+    }
+    if (fromValid) {
+        toZ = Math.round(gSize + posZ + 0.5) -gSize - 0.5;
+        toX = Math.round(gSize + posX + 0.5) -gSize - 0.5;
+        if ((fromX == toX) && (fromZ != toZ) && (modality == "obstacles")) {
+            return;
+        }
+        console.log("modality = " + modality);
+        if (modality == "obstacles") {
+            fromValid = false;  
+            toValid = true;         
+            if ((fromX == toX) && (fromZ == toZ)) {
+                fromCube.position.y = -0.2;
+                toCube.position.y = -0.2;
+                renderer.render( scene, camera ); 
+                return;
+            }
+            cleanCurve();
+            addObstacle(fromX, fromZ, toX, toZ);
+        }
+        if (modality == "positions") {
+            fromValid = true;         
+            toValid = true;         
+            toCube.position.z = toZ;
+            toCube.position.y = toY;
+            toCube.position.x = toX;
+            renderer.render( scene, camera );
+            positions = {fX : fromX, fZ : fromZ, tX : toX, tZ : toZ }
+            cleanCurve();
+            getCurve();
+        }
+    } else {
+        fromValid = true;         
+        fromZ = Math.round(gSize + posZ + 0.5) -gSize - 0.5;
+        fromX = Math.round(gSize + posX + 0.5) -gSize - 0.5;
+        fromCube.position.z = fromZ;
+        fromCube.position.y = fromY;
+        fromCube.position.x = fromX;
+        toCube.position.y = -0.2;
+        cleanCurve();
+        renderer.render( scene, camera );
+    }
+}
diff --git a/www/jAdd.ml b/www/jAdd.ml
new file mode 100644
index 0000000..a57188e
--- /dev/null
+++ b/www/jAdd.ml
@@ -0,0 +1,57 @@
+(** link code **)
+
+open Js_of_ocaml
+open Add
+
+let rec n2pos n = if n < 2 then XH else 
+                  if n mod 2 == 0 then 
+                  XO (n2pos (n / 2)) else XI (n2pos (n / 2))
+
+let rec pos2n n = 
+  match n with XH -> 1 | XO n -> 2 * (pos2n n) | XI n -> 2 * (pos2n n) + 1
+
+let n2z n = if n = 0 then Z0 else 
+            if 0 < n then Zpos (n2pos n)
+            else Zneg (n2pos n)
+
+let z2n n = match n with
+| Z0 -> 0
+| Zpos n -> pos2n n
+| Zneg n -> - pos2n n
+
+let string2lr s =
+  let le = String.length s in
+  let rec iter i si vi = if i = le then Nil else
+    let v = String.get s i in 
+    if (v == '-') then iter (i + 1) (-1) vi else
+    if (v == '+') then iter (i + 1) (1) vi else
+    if (v == ' ') then Cons (n2z (si * vi), iter (i + 1) 1 0) else
+    iter (i + 1) si (vi * 10 + (Char.code v - 48)) in
+  iter 0 1 0
+
+let rec string2lr1 l = 
+match l with 
+| Cons (n , Cons (Z0, l)) -> Cons ({qnum = n; qden = XH}, (string2lr1 l))
+| Cons (n, Cons (Zpos d, l)) -> Cons ({qnum = n; qden = d}, (string2lr1 l))
+| _ -> Nil
+
+let string2l s = string2lr1 (string2lr s)
+
+let rec l2stringr s l =
+  match l with
+    Nil -> s
+  | Cons (n,l) ->  l2stringr (s ^ (string_of_int (z2n n.qnum)) ^ " " ^
+                                  (string_of_int (pos2n n.qden)) ^ " ")
+                             l
+
+let l2string l = l2stringr "" l
+
+let main s =
+  let l = string2l s in l2string (sum_val l)
+
+let _ =
+  Js.export_all
+    (object%js
+      method add s = Js.string (main (Js.to_string s))
+    end)
+
diff --git a/www/jAdd.mli b/www/jAdd.mli
new file mode 100644
index 0000000..2fe4da4
--- /dev/null
+++ b/www/jAdd.mli
@@ -0,0 +1,6 @@
+open Add
+
+val n2pos : int -> positive
+val pos2n : positive -> int
+val n2z : int -> z
+val z2n : z -> int
diff --git a/www/jSmoothTrajectories.ml b/www/jSmoothTrajectories.ml
new file mode 100644
index 0000000..67f8520
--- /dev/null
+++ b/www/jSmoothTrajectories.ml
@@ -0,0 +1,137 @@
+(** link code **)
+
+open Js_of_ocaml
+open SmoothTrajectories
+
+let rec n2pos n = if n < 2 then XH else 
+                  if n mod 2 == 0 then 
+                  XO (n2pos (n / 2)) else XI (n2pos (n / 2))
+
+let rec pos2n n = 
+  match n with XH -> 1 | XO n -> 2 * (pos2n n) | XI n -> 2 * (pos2n n) + 1
+
+let n2z n = if n = 0 then Z0 else 
+            if 0 < n then Zpos (n2pos n)
+            else Zneg (n2pos n)
+
+let z2n n = match n with
+| Z0 -> 0
+| Zpos n -> pos2n n
+| Zneg n -> - pos2n n
+
+let n2q n d = {qnum = n2z n; qden = n2pos d}
+
+let q2n v =
+let v1 = qred v in  [z2n v1.qnum; pos2n v1.qden]
+
+let n2pt n1 d1 n2 d2 = {p_x = n2q n1 d1; p_y = n2q n2 d2}
+
+let pt2n p = (q2n p.p_x) @ (q2n p.p_y)
+
+let n2edge n1 d1 n2 d2 n3 d3 n4 d4 = 
+  if (n1 <= n3) then
+  { left_pt = n2pt n1 d1 n2 d2; right_pt = n2pt n3 d3 n4 d4}
+  else 
+  { left_pt = n2pt n3 d3 n4 d4; right_pt = n2pt n1 d1 n2 d2}
+  
+let edge2n e = (pt2n e.left_pt) @ (pt2n e.right_pt)
+
+let string2ln s =
+  let le = String.length s in
+  let rec iter i si vi = if i = le then [] else
+    let v = String.get s i in 
+    if (v == '-') then iter (i + 1) (-1) vi else
+    if (v == '+') then iter (i + 1) (1) vi else
+    if (v == ' ') then (si * vi) :: iter (i + 1) 1 0 else
+    iter (i + 1) si (vi * 10 + (Char.code v - 48)) in
+  iter 0 1 0
+
+let rec list2es l = 
+  match l with
+  | en1 :: ed1 :: en2 :: ed2 :: en3 :: ed3 :: en4 :: ed4 :: l1
+    ->
+      Cons (n2edge en1 ed1 en2 ed2 en3 ed3 en4 ed4, list2es l1)
+  | [] -> Nil
+
+
+let annotated_point2n ap = pt2n ap.apt_val
+    
+let curve_element2n ce =
+  match ce with
+| Straight (ap1, ap2) -> 1 :: 0 :: (annotated_point2n ap1 @ annotated_point2n ap2)
+| Bezier (ap1, ap2, ap3) ->
+    2 :: 0 :: (annotated_point2n ap1 @ annotated_point2n ap2 @ annotated_point2n ap3)
+
+let rec curve_elements2n ces =
+  match ces with
+  |  Cons (ce, ces1) -> curve_element2n ce @ curve_elements2n ces1 
+  |  Nil -> []
+
+let rec l2stringr l =
+  match l with
+    [] -> ""
+  | a :: l1 -> if (0 <= a) then 
+               ("+" ^ (string_of_int a) ^ " " ^ l2stringr l1)
+               else 
+               ((string_of_int a) ^ " " ^ l2stringr l1)
+
+let call_smooth s = 
+  let l = string2ln s in
+  match l with
+  | p1n1 :: p1d1 :: p1n2 :: p1d2 :: p2n1 :: p2d1 :: p2n2 ::p2d2 ::
+    e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
+    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
+    ls ->
+    let es = list2es ls in 
+    let v = qsmooth_point_to_point (n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4)
+      (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4)
+      es 
+      (n2pt p1n1 p1d1 p1n2 p1d2)
+      (n2pt p2n1 p2d1 p2n2 p2d2) in 
+    l2stringr (curve_elements2n v)
+
+
+let call_smooth1 s = 
+  let l = string2ln s in
+  match l with
+  | p1n1 :: p1d1 :: p1n2 :: p1d2 :: p2n1 :: p2d1 :: p2n2 ::p2d2 ::
+    e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
+    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
+    ls ->
+    let es = list2es ls in 
+ ((n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4),
+  (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4),
+      es ,
+      (n2pt p1n1 p1d1 p1n2 p1d2),
+      (n2pt p2n1 p2d1 p2n2 p2d2)) 
+
+let rec cells_element2n ce =
+  match ce with
+  | Nil -> []
+  | Cons (a, Nil) -> []
+  | Cons (a, Cons (b, Nil)) -> pt2n a @ pt2n b
+  | Cons (a, Cons (b, c)) -> cells_element2n (Cons (a, c))
+  
+let rec cells_elements2n ces =
+  match ces with
+  |  Cons (ce, ces1) -> cells_element2n (ce.left_pts) @ cells_elements2n ces1 
+  |  Nil -> []
+
+let call_cells s = 
+  let l = string2ln s in
+  match l with
+  | e1n1 :: e1d1 :: e1n2 :: e1d2 :: e1n3 :: e1d3 :: e1n4 :: e1d4 ::
+    e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
+    ls ->
+    let es = list2es ls in 
+    let v = qedges_to_cells (n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4)
+      (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4)
+      es  in 
+    l2stringr (cells_elements2n v)
+
+let _ =
+  Js.export "ocamlLib"
+    (object%js
+      method smooth s = Js.string (call_smooth (Js.to_string s))
+      method cells s = Js.string (call_cells (Js.to_string s))
+    end)
diff --git a/www/jSmoothTrajectories.mli b/www/jSmoothTrajectories.mli
new file mode 100644
index 0000000..1d2f275
--- /dev/null
+++ b/www/jSmoothTrajectories.mli
@@ -0,0 +1,6 @@
+open SmoothTrajectories
+
+val n2pos : int -> positive
+val pos2n : positive -> int
+val n2z : int -> z
+val z2n : z -> int
diff --git a/www/script.js b/www/script.js
new file mode 100644
index 0000000..a0e24cb
--- /dev/null
+++ b/www/script.js
@@ -0,0 +1,171 @@
+import * as THREE from 'three';
+import { FontLoader } from 'three/addons/loaders/FontLoader.js';
+import { TextGeometry } from 'three/addons/geometries/TextGeometry.js';
+
+const renderer = new THREE.WebGLRenderer();
+renderer.setSize( window.innerWidth, window.innerHeight );
+document.body.appendChild( renderer.domElement );
+
+const camera = new THREE.PerspectiveCamera( 45, window.innerWidth / window.innerHeight, 1, 500 );
+camera.position.set( 0, 0, 10 );
+camera.lookAt( 0, 0, 0 );
+
+const scene = new THREE.Scene();
+scene.background = new THREE.Color( 'lightgrey' );
+
+//create a blue LineBasicMaterial
+const material = new THREE.LineBasicMaterial( { color: 'black' } );
+const cmaterial = new THREE.LineBasicMaterial( { color: 'red' } );
+
+/* 
+BOTTOM
+  ({| left_pt := {| p_x := -4; p_y := -4|};
+      right_pt := {| p_x := 4; p_y := -4|}|}).
+
+*/
+
+const bpoints = [];
+bpoints.push( new THREE.Vector3( - 4, - 4, 0 ) );
+bpoints.push( new THREE.Vector3(   4, - 4, 0 ) );
+
+const bgeometry = new THREE.BufferGeometry().setFromPoints( bpoints );
+
+const bline = new THREE.Line( bgeometry, material );
+
+scene.add( bline );
+
+/* 
+Notation TOP :=
+  ({| left_pt := {| p_x := -4; p_y := 2|};
+      right_pt := {| p_x := 4; p_y := 2|}|}).
+
+*/
+
+const tpoints = [];
+tpoints.push( new THREE.Vector3( - 4, 2, 0 ) );
+tpoints.push( new THREE.Vector3(   4, 2, 0 ) );
+
+const tgeometry = new THREE.BufferGeometry().setFromPoints( tpoints );
+
+const tline = new THREE.Line( tgeometry, material );
+
+scene.add( tline );
+
+/* 
+Definition example_edge_list : seq edge :=
+  Bedge (Bpt (-3) 0) (Bpt (-2) 1) ::
+  Bedge (Bpt (-3) 0) (Bpt 0 (-3)) ::
+  Bedge (Bpt 0 (-3)) (Bpt 3 0) ::
+  Bedge (Bpt (-2) 1) (Bpt 0 1) ::
+  Bedge (Bpt 0 1) (Bpt 1 0) ::
+  Bedge (Bpt (-1) 0) (Bpt 0 (-1)) ::
+  Bedge (Bpt 0 (-1)) (Bpt 1 0) :: nil.
+*/
+
+const edge_list = [
+  {fx : -3, fy : 0, tx : -2, ty : 1},  
+  {fx : -3, fy : 0, tx :  0, ty : -3},
+  {fx :  0, fy : -3, tx : 3, ty : 0},
+  {fx :  -2, fy : 1, tx : 0, ty : 1},
+  {fx :  0, fy : 1, tx : 1, ty : 0},
+  {fx :  -1, fy : 0, tx : 0, ty : -1},
+  {fx :  0, fy : -1, tx : 1, ty : 0}
+];
+
+edge_list.forEach(add_edge);
+
+function add_edge(edge) {
+  let epoints = [];
+  epoints.push( new THREE.Vector3(edge.fx, edge.fy, 0 ) );
+  epoints.push( new THREE.Vector3(edge.tx, edge.ty, 0 ) );
+  let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
+  let eline = new THREE.Line( egeometry, material );
+  scene.add( eline );
+}
+
+/* curve
+	 = straight {| p_x := -1.9; p_y := -3 # 2 |};
+              {| p_x := -19 # 20; p_y := -480 # 192 |} :: 
+      bezier  {| p_x := -19 # 20; p_y := -480 # 192 |};
+              {| p_x := 0; p_y := -168 # 48 |}
+              {| p_x := 3 # 2; p_y := -12672 # 4608 |}; ::
+      bezier  {| p_x := 3 # 2; p_y := -12672 # 4608 |};
+              {| p_x := 3; p_y := -96 # 48 |}
+              {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |} :: 
+      bezier  {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |}
+              {| p_x := 28 # 8; p_y := (-0x1.000)%xQ |}
+              {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}  ::
+      bezier  {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}
+              {| p_x := 3; p_y := 0x1.0%xQ |}
+              {| p_x := 4 # 2; p_y := 0 # 192 |} ::
+      bezier  {| p_x := 4 # 2; p_y := 0 # 192 |}
+              {| p_x := 1; p_y := -6 # 6 |}
+              {| p_x := 1 # 2; p_y := -36 # 24 |} ::
+      bezier  {| p_x := 1 # 2; p_y := -36 # 24 |}
+              {| p_x := 0; p_y := -4 # 2 |}
+              {| p_x := -1 # 2; p_y := -36 # 24 |}
+      bezier  {| p_x := -1 # 2; p_y := -36 # 24 |}
+              {| p_x := -1; p_y := -6 # 6 |}
+              {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |} ::
+      bezier  {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |}
+              {| p_x := -12 # 8; p_y := -36 # 144 |}
+              {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |} ::
+      bezier  {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |}
+              {| p_x := -1; p_y := 2 # 4 |}
+              {| p_x := -1 # 2; p_y := 8 # 32 |} ::
+      bezier  {| p_x := -1 # 2; p_y := 8 # 32 |};
+               ({| p_x := 0; p_y := 0|}).
+              {| p_x := 1 # 6; p_y := 0 # 8 |} ::
+      straight {| p_x := 1 # 6; p_y := 0 # 8 |};
+               {| p_x := 1 # 3; p_y := 0 |};
+*/
+
+const curve_list = [
+  {b : false, fx : -1.9, fy : -(3/2), tx : -(19/20), ty : - (480 / 192)},  
+  {b : true, fx : -(19/20), fy : -(480/192), 
+             cx : 0, cy : -(168/48), tx : (3/2), ty : -(12672/4608)},
+ {b : true, fx : (3/2), fy : -(12672/4608), 
+             cx : 3, cy : -(96/48), tx : (3 + 4/16), ty : -(589824/393216)},
+ {b : true, fx : (3 + 4 /16), fy : -(589824/393216), 
+             cx : (28/8), cy : -(1), tx : (3 + 4/16), ty : 0},
+ {b : true, fx : (3 + 4/16), fy : 0, 
+             cx : 3, cy : 1.0, tx : (4/2), ty : 0},
+ {b : true, fx : (4/2), fy : 0, 
+             cx : 1, cy : -(6/6), tx : (1/2), ty : -(36/24)},
+ {b : true, fx : (1/2), fy : -(36/24), 
+             cx : 0, cy : -(4/2), tx : -(1/2), ty : -(36/24)},
+ {b : true, fx : -(1/2), fy : -(36/24), 
+             cx : -1, cy : -(6/6), tx : -(1 + 4 / 16), ty : -(1080/1728)},
+ {b : true, fx : -(1 + 4 / 16), fy : -(1080/1728), 
+             cx : -(12/8), cy : -(36/144), tx : -(1 + 4/16), ty : (144/1152)},
+ {b : true, fx : -(1 + 4 / 16), fy : (144/1152), 
+             cx : -1, cy : (2/4), tx : -(1/2), ty : (8/32)},
+ {b : true, fx : -(1/2), fy : (8/32), 
+             cx : 0, cy : 0, tx : (1/6), ty : 0},
+  {b : false, fx : (1/6), fy : 0, tx : (1/3), ty : 0}  
+];
+
+curve_list.forEach(add_curve);
+
+function add_curve(curve) {
+  if (curve.b) {
+    let ccurve = new THREE.QuadraticBezierCurve3(
+                	new THREE.Vector3(curve.fx, curve.fy, 0 ),
+	                new THREE.Vector3(curve.cx, curve.cy, 0 ),
+	                new THREE.Vector3(curve.tx, curve.ty, 0 )
+                );
+    let cpoints = ccurve.getPoints( 50 );
+    let cgeometry = new THREE.BufferGeometry().setFromPoints( cpoints );
+    let cline = new THREE.Line( cgeometry, cmaterial );
+    scene.add( cline );
+  } else {
+    let epoints = [];
+    epoints.push( new THREE.Vector3(curve.fx, curve.fy, 0 ) );
+    epoints.push( new THREE.Vector3(curve.tx, curve.ty, 0 ) );
+    let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
+    let sline = new THREE.Line( egeometry, cmaterial );
+    scene.add( sline );
+  }
+}
+
+renderer.render( scene, camera );

From 4128069e1b39a14fdeafa7157ab89a00a4d22aa8 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 23 Apr 2024 15:21:17 +0200
Subject: [PATCH 13/43] preliminary version of Dijkstra's algorithm, based on a
 purported implem. of a priority queue

---
 theories/shortest_path.v | 67 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 theories/shortest_path.v

diff --git a/theories/shortest_path.v b/theories/shortest_path.v
new file mode 100644
index 0000000..b184df8
--- /dev/null
+++ b/theories/shortest_path.v
@@ -0,0 +1,67 @@
+From mathcomp Require Import all_ssreflect all_algebra.
+Require Import ZArith List String OrderedType OrderedTypeEx FMapAVL.
+
+Notation head := seq.head.
+Notation seq := seq.seq.
+Notation sort := path.sort.
+
+Section shortest_path.
+
+Variable R : numFieldType.
+Variable cell : Type.
+Variable cells : seq cell.
+Variable node : eqType.
+Variable neighbors_of_node : node -> seq (node * R).
+Variable source target : node.
+
+Definition path := seq node.
+Variable priority_queue : Type.
+Variable empty : priority_queue.
+Variable find : priority_queue -> node -> option (path * option R).
+Variable update : priority_queue -> node -> path -> option R -> priority_queue.
+Variable pop :  priority_queue -> option (node * path * option R * priority_queue).
+
+Definition cmp_option (v v' : option R) :=
+  if v is Some x then
+    if v' is Some y then
+       (x < y)%O
+    else
+      true
+   else
+     false.
+
+Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
+  (q : priority_queue) : priority_queue :=
+  let neighbors := neighbors_of_node d in
+  foldr (fun '(d', dist') q => 
+           match find q d' with
+           | None => q
+           | Some (p', o_dist) =>
+             let new_dist_to_d' := Some (dist + dist')%R in
+             if cmp_option new_dist_to_d' o_dist then
+                update q d' (d :: p) new_dist_to_d'
+             else q
+           end) q neighbors.
+
+Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
+  match fuel with
+  | 0 => None
+  |S fuel' =>
+    match pop q with
+    | Some (d, p, Some dist, q') =>
+      if d == target then Some p else 
+        Dijkstra fuel' (Dijkstra_step d p dist q')
+    | _ => None
+    end
+  end.
+
+Definition shortest_path (s : seq node) :=
+  Dijkstra (size s)
+    (foldr [fun n q => update q n [::] None] empty s).
+  
+Definition neighbors_of_node (d : node) :  seq (node * R) :=
+  let (c1, c2) := node_to_cells d in
+  let ds1 := cell_to_nodes c1 in
+  let ds2 := cell_to_nodes c2 in
+  let ds := undup [seq x | x <- ds1 ++ ds2 & x != d] in
+  [seq (x, node_distance d x) | x <- ds].

From 495a9569026aa5080f741dc9cbc6fd50dda7c498 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 23 Apr 2024 15:23:38 +0200
Subject: [PATCH 14/43] when turning around in a cell, avoid aiming at the cell
 center, if possible

---
 theories/generic_trajectories.v | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 30e997d..d176b1a 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -665,6 +665,22 @@ end.
 Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
   List.map (fun p => (snd p, fst p)) (List.rev_append s nil).
 
+Definition strict_inside_closed p c :=
+  negb (point_under_edge p (low c)) &&
+  point_strictly_under_edge p (high c) &&
+ (R_ltb (left_limit c) (p_x p) &&
+ (R_ltb (p_x p) (right_limit c))).
+
+Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
+   (ci : nat) :=
+  let new_x := p_x (cell_center c) in
+  let new_y := R_div (R_add (p_y p1) (p_y p2)) R2 in
+  let new_pt := {|p_x := new_x; p_y := new_y|} in
+    if strict_inside_closed new_pt c then
+      Apt new_pt (ci :: nil)
+    else
+      Apt (cell_center c) (ci :: nil).
+
 (* This function creates a safe path from the door between
   c1 and c2 and the door between c2 and c3.  When op1 and op2
   are not provided, midpoints are used as path anchors,
@@ -692,8 +708,7 @@ let p2 := match op2 with
             end
           end in
 if R_eqb (p_x p1) (p_x p2) then
-  let intermediate_point :=
-    Apt (cell_center c2) (c2i :: nil) in
+  let intermediate_point :=  safe_intermediate_point_in_cell p1 p2 c2 c2i in
   (Apt p1 (c1i :: c2i :: nil), intermediate_point) ::
   (intermediate_point, Apt p2 (c2i :: c3i :: nil)) :: nil
 else
@@ -740,12 +755,6 @@ Definition path_adjacent_cells (cells : seq cell) (source target : pt)
   | None => None
   end.
 
-Definition strict_inside_closed p c :=
-  negb (point_under_edge p (low c)) &&
-  point_strictly_under_edge p (high c) &&
- (R_ltb (left_limit c) (p_x p) &&
- (R_ltb (p_x p) (right_limit c))).
-
 (* find_origin_cells returns a list of cell indices. *)
 (* If the list is empty, it should mean that the point is not in the
   safe part of the work space (it is either outside the box or on

From 606a032690772729757f2809bcb4c150868bda28 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Wed, 24 Apr 2024 15:30:19 +0900
Subject: [PATCH 15/43] fix

---
 _CoqProject                   |  2 --
 html/Makefile                 | 11 -----------
 theories/extraction_command.v |  2 +-
 theories/no_crossing.v        |  2 +-
 4 files changed, 2 insertions(+), 15 deletions(-)
 delete mode 100644 html/Makefile

diff --git a/_CoqProject b/_CoqProject
index c03140a..a923345 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -39,5 +39,3 @@ theories/smooth_trajectories.v
 
 -arg -w -arg -notation-overridden
 -arg -w -arg -ambiguous-paths
-theories/smooth_trajectories.v
-theories/generic_trajectories.v
diff --git a/html/Makefile b/html/Makefile
deleted file mode 100644
index 07218d0..0000000
--- a/html/Makefile
+++ /dev/null
@@ -1,11 +0,0 @@
-all: Makefile.coq
-	make -f Makefile.coq
-
-Makefile.coq:
-	coq_makefile *.v -o Makefile.coq
-
-run:
-	python3 -m http.server
-
-clean:
-	make -f Makefile.coq clean
\ No newline at end of file
diff --git a/theories/extraction_command.v b/theories/extraction_command.v
index ab2c479..5c0ee72 100644
--- a/theories/extraction_command.v
+++ b/theories/extraction_command.v
@@ -1,4 +1,4 @@
-From trajectories Require Import smooth_trajectories.
+From trajectories Require Import generic_trajectories smooth_trajectories.
 Require Import QArith.
 
 Extraction "smooth_trajectories" smooth_point_to_point example_bottom example_top
diff --git a/theories/no_crossing.v b/theories/no_crossing.v
index 0d81e85..2be8261 100644
--- a/theories/no_crossing.v
+++ b/theories/no_crossing.v
@@ -104,7 +104,7 @@ Definition have_crossing (e1 e2 : edge) : bool :=
   else
    (* The two edges are parallel.  They may still touch. *)
    if negb (Qeq_bool 
-             (area3 (left_pt e1) (left_pt e2) (right_pt e2)) 0) then
+             (area3 _ Qplus Qminus Qmult (left_pt e1) (left_pt e2) (right_pt e2)) 0) then
      true
    else
      (Qlt_bool (p_x (left_pt e2)) (p_x (left_pt e1)) &&

From 4d24e915897f26dfa69fb3db77252727bde22878 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Wed, 24 Apr 2024 11:00:07 +0200
Subject: [PATCH 16/43] finished implementation of shortest path tested on one
 example

---
 theories/shortest_path.v | 202 +++++++++++++++++++++++++++++++++++----
 1 file changed, 186 insertions(+), 16 deletions(-)

diff --git a/theories/shortest_path.v b/theories/shortest_path.v
index b184df8..8145e38 100644
--- a/theories/shortest_path.v
+++ b/theories/shortest_path.v
@@ -1,16 +1,21 @@
 From mathcomp Require Import all_ssreflect all_algebra.
-Require Import ZArith List String OrderedType OrderedTypeEx FMapAVL.
+Require Import ZArith (* List *) String OrderedType OrderedTypeEx FMapAVL.
+Require Import smooth_trajectories.
 
 Notation head := seq.head.
 Notation seq := seq.seq.
+Notation nth := seq.nth.
 Notation sort := path.sort.
 
 Section shortest_path.
 
-Variable R : numFieldType.
+Variable R : Type.
+Variable R0 : R.
+Variable ltb : R -> R -> bool.
+Variable add : R -> R -> R.
 Variable cell : Type.
-Variable cells : seq cell.
-Variable node : eqType.
+Variable node : Type.
+Variable node_eqb : node -> node -> bool.
 Variable neighbors_of_node : node -> seq (node * R).
 Variable source target : node.
 
@@ -24,7 +29,7 @@ Variable pop :  priority_queue -> option (node * path * option R * priority_queu
 Definition cmp_option (v v' : option R) :=
   if v is Some x then
     if v' is Some y then
-       (x < y)%O
+       (ltb x y)%O
     else
       true
    else
@@ -37,7 +42,7 @@ Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
            match find q d' with
            | None => q
            | Some (p', o_dist) =>
-             let new_dist_to_d' := Some (dist + dist')%R in
+             let new_dist_to_d' := Some (add dist dist')%R in
              if cmp_option new_dist_to_d' o_dist then
                 update q d' (d :: p) new_dist_to_d'
              else q
@@ -45,11 +50,11 @@ Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
 
 Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
   match fuel with
-  | 0 => None
+  | 0%nat => None
   |S fuel' =>
     match pop q with
     | Some (d, p, Some dist, q') =>
-      if d == target then Some p else 
+      if node_eqb d target then Some p else 
         Dijkstra fuel' (Dijkstra_step d p dist q')
     | _ => None
     end
@@ -57,11 +62,176 @@ Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
 
 Definition shortest_path (s : seq node) :=
   Dijkstra (size s)
-    (foldr [fun n q => update q n [::] None] empty s).
-  
-Definition neighbors_of_node (d : node) :  seq (node * R) :=
-  let (c1, c2) := node_to_cells d in
-  let ds1 := cell_to_nodes c1 in
-  let ds2 := cell_to_nodes c2 in
-  let ds := undup [seq x | x <- ds1 ++ ds2 & x != d] in
-  [seq (x, node_distance d x) | x <- ds].
+    (update (foldr [fun n q => update q n [::] None] empty s)
+        source [::] (Some R0)).
+
+End shortest_path.
+
+Import generic_trajectories.
+Notation cell := (cell R edge).
+
+Notation v_eqb := (vert_edge_eqb R QArith_base.Qeq_bool).
+Notation cell_left_doors :=
+   (cell_safe_exits_left R (QArith_base.inject_Z 1) edge).
+Notation cell_right_doors :=
+   (cell_safe_exits_right R (QArith_base.inject_Z 1) edge).
+
+Notation dummy_cell := (dummy_cell R (QArith_base.inject_Z 1) edge Bedge).
+
+Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
+  zip (iota 0 (size s)) s.
+
+Definition cells_to_doors (s : list cell) :=
+  let indexed_s := index_seq s in
+  let vert_edges_and_right_cell :=
+    flatten (map (fun '(i, c) => 
+                   (map (fun v => (v, i))) (cell_left_doors c))
+      indexed_s) in
+  let vert_edges_and_both_cells :=
+    flatten (map (fun '(v, i) => 
+          (map (fun '(i', c') => (v, i, i'))
+               (filter (fun '(i', c') =>
+                   existsb (v_eqb v) (cell_right_doors c'))
+                   indexed_s)))
+           vert_edges_and_right_cell) in 
+      vert_edges_and_both_cells.
+
+Notation on_vert_edge :=
+  (on_vert_edge R QArith_base.Qeq_bool QArith_base.Qle_bool).
+
+Notation vert_edge_midpoint :=
+  (vert_edge_midpoint R QArith_base.Qplus QArith_base.Qdiv  (QArith_base.inject_Z 1)).
+
+Definition vert_edge_to_reference_point (s t : pt R) (v : vert_edge R) :=
+  if on_vert_edge s v then s
+  else if on_vert_edge t v then t
+  else vert_edge_midpoint v.
+
+Definition one_door_neighbors
+  (indexed_doors : seq (nat * (vert_edge R * nat * nat)))
+  (i_d : nat * (vert_edge R * nat * nat)) : list nat :=
+  match i_d with
+  | (j, (v0, i0, i'0)) =>
+    map fst
+      (filter (fun '(vi, (v, i, i')) => (Nat.eqb i i0  || Nat.eqb i i'0 ||
+              Nat.eqb i' i0 || Nat.eqb i' i'0) && (negb (Nat.eqb j vi)))
+          indexed_doors)
+  end.
+
+Notation strict_inside_closed :=
+  (strict_inside_closed R QArith_base.Qeq_bool QArith_base.Qle_bool QArith_base.Qplus QArith_base.Qminus QArith_base.Qmult (QArith_base.inject_Z 1) edge left_pt
+   right_pt).
+
+Definition add_extremity_reference_point
+  (indexed_cells : seq (nat * cell))
+  (doors : seq (vert_edge R * nat * nat)) (p : pt R) :=
+  if existsb (fun '(v, _, _) => on_vert_edge p v) doors then
+    [::]
+  else 
+    let '(i, c) :=
+      head (size indexed_cells, dummy_cell)
+        (filter (fun '(i', c') => strict_inside_closed p c')  indexed_cells) in
+      [:: ({|ve_x := p_x _ p; ve_top := p_y _ p; ve_bot := p_y _ p|}, i, i)].
+
+Definition doors_and_extremities (indexed_cells : seq (nat * cell))
+  (doors : seq (vert_edge R * nat * nat)) (s t : pt R) :=
+  add_extremity_reference_point indexed_cells doors s ++
+  add_extremity_reference_point indexed_cells doors t ++
+  doors.
+
+Definition door_adjacency_map (doors : seq (vert_edge R * nat * nat)) :
+  seq (seq nat) :=
+  let indexed_doors := index_seq doors in
+  map (fun i_d => one_door_neighbors indexed_doors i_d) indexed_doors.
+
+Notation dummy_vert_edge :=
+ (dummy_vert_edge R QArith_base.Qminus (QArith_base.inject_Z 1)).
+
+Definition dummy_door := (dummy_vert_edge, 0, 0).
+
+Definition distance (doors : seq (vert_edge R * nat * nat)) (s t : pt R) 
+  (i j : nat) :=
+  let '(v1, _, _) := nth dummy_door doors i in
+  let '(v2, _, _) := nth dummy_door doors j in
+  let p1 := vert_edge_to_reference_point s t v1 in
+  let p2 := vert_edge_to_reference_point s t v2 in
+  pt_distance p1 p2.
+
+Definition cells_to_doors_graph (cells : seq cell) (s t : pt R) :=
+  let regular_doors := cells_to_doors cells in
+  let indexed_cells := index_seq cells in
+  let full_seq_of_doors :=
+    doors_and_extremities indexed_cells regular_doors s t in
+  let adj_map := door_adjacency_map full_seq_of_doors in
+  let neighbors_and_distances :=
+    [seq [seq (j, distance full_seq_of_doors s t i j) | j <- neighbors]
+        | '(i, neighbors) <- index_seq adj_map] in
+      (full_seq_of_doors, neighbors_and_distances).
+
+(* TODO : beware of the case where s and t are on the same door, they can't
+   both be the reference point! *)
+
+Import generic_trajectories.
+
+Definition node := nat.
+
+Definition empty := @nil (node * path node * option R).
+
+Notation priority_queue := (list (node * path node * option R)).
+
+Definition node_eqb := Nat.eqb.
+
+Fixpoint find (q : priority_queue) n :=
+  match q with
+  | nil => None
+  | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else find tl n
+  end.
+
+Fixpoint remove (q : priority_queue) n :=
+  match q with
+  | nil => nil
+  | (n', p', d') :: tl =>
+    if node_eqb n' n then
+      tl
+    else
+      (n', p', d') :: remove tl n
+  end.
+
+Fixpoint insert (q : priority_queue) n p d :=
+  match q with
+  | nil => (n, p, d) :: nil
+  | (n', p', d') :: tl =>
+    if cmp_option R QArith_base.Qle_bool d d' then
+      (n, p, d) :: q
+    else
+      (n', p', d') :: insert tl n p d
+  end.
+
+Definition update q n p d :=
+  insert (remove q n) n p d.
+
+Definition pop  (q : priority_queue) :
+   option (node * path node * option R * priority_queue) :=
+  match q with
+  | nil => None
+  | v :: tl => Some (v, tl)
+  end.
+
+Section example.
+
+Import QArith.
+Check Qedges_to_cells.
+Definition bottom := Bedge (Bpt _ 0 0) (Bpt _ 4 0).
+Definition top := Bedge (Bpt _ 0 4) (Bpt _ 4 4).
+Definition edges := [:: Bedge (Bpt _ 1 2) (Bpt _ 3 2)].
+Definition start := Bpt _ 1.2 3.
+Definition target := Bpt _ 1.2 1.
+Notation Bpt := (smooth_trajectories.Bpt _).
+
+Definition adj := cells_to_doors_graph (Qedges_to_cells bottom top edges)
+                      start target.
+Compute adj.                      
+Compute shortest_path R 0 Qlt_bool Qplus nat Nat.eqb
+    (nth nil adj.2) 0%N 1%N _ empty find update pop (iota 0 (size adj.2)).
+
+End example.

From 76915bc83ab294ebd7537e863f10616f5a0deeaa Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Thu, 25 Apr 2024 04:26:00 +0200
Subject: [PATCH 17/43] now use shortest path computation

---
 theories/generic_trajectories.v | 615 ++++++++++++++------------------
 theories/smooth_trajectories.v  |  28 +-
 2 files changed, 281 insertions(+), 362 deletions(-)

diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index d176b1a..811c9ed 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -1,5 +1,5 @@
 From mathcomp Require Import all_ssreflect.
-Require Import ZArith List String OrderedType OrderedTypeEx FMapAVL.
+Require Import ZArith (* List *) String OrderedType OrderedTypeEx FMapAVL.
 
 Notation head := seq.head.
 Notation sort := path.sort.
@@ -52,6 +52,8 @@ Notation "x - y" := (R_sub x y).
 
 Notation "x + y" := (R_add x y).
 
+Variable pt_distance : R -> R -> R -> R -> R.
+
 Variable R1 : R.
 
 Let R0 := R_sub R1 R1.
@@ -427,79 +429,65 @@ Definition edges_to_cells bottom top edges :=
   complete_process (edges_to_events edges) bottom top.
 
 (* SECOND PART : computing a path in the cell graph *)
-(* This code is taken from github.com/ybertot/breadth_first_search.
-   the proof of this code is probably complete in that repository. *)
-
-Section bfs.
-
-Variable (state move : Type).
-Variable (state_fmap : Type).
-Variable find : state_fmap -> state -> option move.
-Variable add : state_fmap -> state -> move -> state_fmap.
-Variable (step : state -> list (state * move)).
-Variable (state_eq_dec : forall s1 s2 : state, {s1 = s2}+{s1 <> s2}).
-
-Variable map_order : state_fmap -> state_fmap -> Prop.
-Hypothesis map_order_wf : well_founded map_order.
-Hypothesis add_order : forall map s v,
-  find map s = None -> map_order (add map s v) map.
-Hypothesis map_order_trans : forall map2 map1 map3,
-  map_order map1 map2 -> map_order map2 map3 -> map_order map1 map3.
-
-Fixpoint bfs_aux (w w2 : list (state * move))
-  (sufficient : state)
-  (settled : state_fmap) : (list (state * move) * state_fmap) :=
-match w with
-| (s, m) :: w' =>
-  match find settled s with
-  | Some _ => bfs_aux w' w2 sufficient settled
-  | None =>
-    if state_eq_dec s sufficient then
-      (nil, add settled s m)
+(* To compute a path that has reasonable optimzation, we compute a shortest *)
+(* path between reference points chosen inside doors. *)
+
+Section shortest_path.
+
+Variable cell : Type.
+Variable node : Type.
+Variable node_eqb : node -> node -> bool.
+Variable neighbors_of_node : node -> seq (node * R).
+Variable source target : node.
+
+Definition path := seq node.
+Variable priority_queue : Type.
+Variable empty : priority_queue.
+Variable find : priority_queue -> node -> option (path * option R).
+Variable update : priority_queue -> node -> path -> option R -> priority_queue.
+Variable pop :  priority_queue -> option (node * path * option R * priority_queue).
+
+Definition cmp_option (v v' : option R) :=
+  if v is Some x then
+    if v' is Some y then
+       (R_ltb x y)%O
     else
-    bfs_aux w' (step s ++ w2) sufficient (add settled s m)
-  end
-| nil => (w2, settled)
-end.
-
-Fixpoint bfs (fuel : nat) (w : list (state * move)) (settled : state_fmap) 
-  (sufficient : state)
-  (round : nat) :
-  (state_fmap * nat) + (list (state * move) * state_fmap) :=
+      true
+   else
+     false.
+
+Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
+  (q : priority_queue) : priority_queue :=
+  let neighbors := neighbors_of_node d in
+  foldr (fun '(d', dist') q => 
+           match find q d' with
+           | None => q
+           | Some (p', o_dist) =>
+             let new_dist_to_d' := Some (R_add dist dist') in
+             if cmp_option new_dist_to_d' o_dist then
+                update q d' (d :: p) new_dist_to_d'
+             else q
+           end) q neighbors.
+
+Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
   match fuel with
-  | O => inr (w, settled)
-  | S p =>
-    match bfs_aux w nil sufficient settled with
-    | (nil, s) => inl (s, round)
-    | (w, s) => bfs p w s sufficient (round + 1)
+  | 0%nat => None
+  |S fuel' =>
+    match pop q with
+    | Some (d, p, Some dist, q') =>
+      if node_eqb d target then Some p else 
+        Dijkstra fuel' (Dijkstra_step d p dist q')
+    | _ => None
     end
   end.
 
-  (* We then explain how we build a path using the database. *)
-Fixpoint make_path (db : state_fmap)
-(targetb : state -> bool) (play : state -> move -> option state)
-(x : state) (fuel : nat) :=
-match fuel with
-| O => None
-| S p =>
-if targetb x then
-  Some nil
-else
-  match find db x with
-  | None => None
-  | Some m =>
-    match play x m with
-    | Some y =>
-      match make_path db targetb play y p with
-      | None => None
-      | Some l => Some (m :: l)
-      end
-   | None => None
-   end
-  end
-end.
+Definition shortest_path (s : seq node) :=
+  Dijkstra (size s)
+    (update (foldr [fun n q => update q n [::] None] empty s)
+        source [::] (Some R0)).
+
+End shortest_path.
 
-End bfs.
 
 (* defining the connection relation between adjacent cells.  Two cells
   are adjacent when it is possible to move from one cell directly to the
@@ -536,95 +524,151 @@ Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p))) 
    (seq_to_intervals (rev (right_pts c))).
 
-Definition all_doors (cells : seq cell) : seq (vert_edge * nat) :=
-  List.concat
-    (List.map (fun i => List.map (fun v => (v, i))
-                  (cell_safe_exits_right (nth i cells dummy_cell)))
-         (seq.iota 0 (List.length cells))).
+Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
+  zip (iota 0 (size s)) s.
+
+Definition cells_to_doors (s : list cell) :=
+  let indexed_s := index_seq s in
+  let vert_edges_and_right_cell :=
+    flatten (map (fun '(i, c) => 
+                   (map (fun v => (v, i))) (cell_safe_exits_left c))
+      indexed_s) in
+  let vert_edges_and_both_cells :=
+    flatten (map (fun '(v, i) => 
+          (map (fun '(i', c') => (v, i, i'))
+               (filter (fun '(i', c') =>
+                   existsb (vert_edge_eqb v) (cell_safe_exits_right c'))
+                   indexed_s)))
+           vert_edges_and_right_cell) in 
+      vert_edges_and_both_cells.
 
-Definition door_right_cell (cells : seq cell) (v : vert_edge) :=
-  find (fun i => existsb (fun v' => vert_edge_eqb v v')
-           (cell_safe_exits_left (nth i cells dummy_cell)))
-     (seq.iota 0 (List.length cells)).
+Definition on_vert_edge (p : pt) (v : vert_edge) : bool :=
+  R_eqb (p_x p) (ve_x v) && R_ltb (ve_bot v) (p_y p) &&
+  R_ltb (p_y p) (ve_top v).
 
 Definition vert_edge_midpoint (ve : vert_edge) : pt :=
   {|p_x := ve_x ve; p_y := R_div ((R_add (ve_top ve) (ve_bot ve))) R2|}.
+ 
+Definition vert_edge_to_reference_point (s t : pt) (v : vert_edge) :=
+  if on_vert_edge s v then s
+  else if on_vert_edge t v then t
+  else vert_edge_midpoint v.
+
+Definition one_door_neighbors
+  (indexed_doors : seq (nat * (vert_edge * nat * nat)))
+  (i_d : nat * (vert_edge * nat * nat)) : list nat :=
+  match i_d with
+  | (j, (v0, i0, i'0)) =>
+    map fst
+      (filter (fun '(vi, (v, i, i')) => (Nat.eqb i i0  || Nat.eqb i i'0 ||
+              Nat.eqb i' i0 || Nat.eqb i' i'0) && (negb (Nat.eqb j vi)))
+          indexed_doors)
+  end.
+
+Definition left_limit (c : cell) := p_x (seq.last dummy_pt (left_pts c)).
+
+Definition right_limit c := p_x (seq.last dummy_pt (right_pts c)).
 
-(* connection from left to right is obtained by computing an intersection. *)
-Definition lr_connected (c1 c2 : cell) : bool :=
-  existsb (fun v => existsb (fun v' => vert_edge_eqb v v')
-                       (cell_safe_exits_left c2))
-       (cell_safe_exits_right c1).
+Definition strict_inside_closed p c :=
+  negb (point_under_edge p (low c)) &&
+  point_strictly_under_edge p (high c) &&
+ (R_ltb (left_limit c) (p_x p) &&
+ (R_ltb (p_x p) (right_limit c))).
 
-Definition bi_connected c1 c2 :=
-  lr_connected c1 c2 || lr_connected c2 c1.
+Definition add_extremity_reference_point
+  (indexed_cells : seq (nat * cell))
+  (doors : seq (vert_edge * nat * nat)) (p : pt) :=
+  if existsb (fun '(v, _, _) => on_vert_edge p v) doors then
+    [::]
+  else 
+    let '(i, c) :=
+      head (size indexed_cells, dummy_cell)
+        (filter (fun '(i', c') => strict_inside_closed p c')  indexed_cells) in
+      [:: ({|ve_x := p_x p; ve_top := p_y p; ve_bot := p_y p|}, i, i)].
+
+Definition doors_and_extremities (indexed_cells : seq (nat * cell))
+  (doors : seq (vert_edge * nat * nat)) (s t : pt) :=
+  add_extremity_reference_point indexed_cells doors s ++
+  add_extremity_reference_point indexed_cells doors t ++
+  doors.
+
+Definition door_adjacency_map (doors : seq (vert_edge * nat * nat)) :
+  seq (seq nat) :=
+  let indexed_doors := index_seq doors in
+  map (fun i_d => one_door_neighbors indexed_doors i_d) indexed_doors.
 
 Definition dummy_vert_edge :=
   {| ve_x := R0; ve_top := R0; ve_bot := R0|}.
 
-Definition bfs_find : natmap.t nat -> nat -> option nat :=
-  (fun m k => natmap.find k m).
-
-Definition bfs_add : natmap.t nat -> nat -> nat -> natmap.t nat :=
-  (fun m k v => natmap.add k v m).
-
-Definition reverse_step cells cell_i : seq (nat * nat) :=
-  map (fun i => (i, cell_i))
-    (filter (fun c_i => bi_connected (nth c_i cells dummy_cell)
-                       (nth cell_i cells dummy_cell))
-     (seq.iota 0 (List.length cells))).
-
-(* To compute a path between two cells we use as input the list of cells
-   and indices of two cells in this list (source and target).  This builds
-   a table.  This table construction is interrupted as soon as a path
-   from source_i to target_i is found, and this path is guaranteed to be
-   of minimal length in terms of numbers of cells encountered. The result
-   is in a sum type, where only the right variant would mean that no path
-   has been found before exhaustion of some fuel.  But here, it is assumed
-   that the fuel (length of cells) is going to be enough to find all cells
-   connected to target_i. *)
-Definition cell_connection_table (cells : seq cell) (source_i target_i : nat) :=
-    bfs _ _ _ bfs_find bfs_add (reverse_step cells) eq_nat_dec
-    (List.length cells) ((target_i, target_i) :: nil) (natmap.empty nat)
-    source_i 0.
-
-Definition cell_path (cells : seq cell) (source_i target_i : nat) :
-  option (seq nat) :=
-  match cell_connection_table cells source_i target_i with
-  | inr _ => None
-  | inl (table, _) =>
-    make_path _ _ _ bfs_find table (fun c_i => Nat.eqb c_i target_i)
-      (fun n1 n2 => Some n2) source_i (List.length cells)
+Definition dummy_door := (dummy_vert_edge, 0, 0).
+
+Definition distance (doors : seq (vert_edge * nat * nat)) (s t : pt) 
+  (i j : nat) :=
+  let '(v1, _, _) := seq.nth dummy_door doors i in
+  let '(v2, _, _) := seq.nth dummy_door doors j in
+  let p1 := vert_edge_to_reference_point s t v1 in
+  let p2 := vert_edge_to_reference_point s t v2 in
+  pt_distance (p_x p1) (p_y p1) (p_x p2) (p_y p2).
+
+Definition cells_to_doors_graph (cells : seq cell) (s t : pt) :=
+  let regular_doors := cells_to_doors cells in
+  let indexed_cells := index_seq cells in
+  let full_seq_of_doors :=
+    doors_and_extremities indexed_cells regular_doors s t in
+  let adj_map := door_adjacency_map full_seq_of_doors in
+  let neighbors_and_distances :=
+    [seq [seq (j, distance full_seq_of_doors s t i j) | j <- neighbors]
+        | '(i, neighbors) <- index_seq adj_map] in
+      (full_seq_of_doors, neighbors_and_distances).
+
+Definition node := nat.
+
+Definition empty := @nil (node * path node * option R).
+
+Notation priority_queue := (list (node * path node * option R)).
+
+Definition node_eqb := Nat.eqb.
+
+Fixpoint find (q : priority_queue) n :=
+  match q with
+  | nil => None
+  | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else find tl n
   end.
 
-(* Given two cells, we define the door from one cell to the other to
-  be the common edge between these cells.  In example known so far, there
-  is only one such door, but this may change in the future.  For now, we
-  take arbitrarily the first one we find (the top one or the bottom one
-  depending on the exits are ordered).  If the two cells are not adjacent,
-  dummy_vert_edge is returned.  Maybe this should be made safer by returning
-  an option type. *)
-Definition lr_door (c1 c2 : cell) : vert_edge :=
-  head dummy_vert_edge
-     (filter (fun x => existsb (fun x' => vert_edge_eqb x x')
-                  (cell_safe_exits_left c2)) (cell_safe_exits_right c1)).
+Fixpoint remove (q : priority_queue) n :=
+  match q with
+  | nil => nil
+  | (n', p', d') :: tl =>
+    if node_eqb n' n then
+      tl
+    else
+      (n', p', d') :: remove tl n
+  end.
 
-Definition left_limit (c : cell) := p_x (seq.last dummy_pt (left_pts c)).
+Fixpoint insert (q : priority_queue) n p d :=
+  match q with
+  | nil => (n, p, d) :: nil
+  | (n', p', d') :: tl =>
+    if cmp_option d d' then
+      (n, p, d) :: q
+    else
+      (n', p', d') :: insert tl n p d
+  end.
 
-Definition right_limit c := p_x (seq.last dummy_pt (right_pts c)).
+Definition update q n p d :=
+  insert (remove q n) n p d.
 
-(* This function is like lr_door, but it is more precise, as it
-  can be applied when the doors are connected but not lr_connected as it
-  returns None in case the two given cells are not adjacent. *)
-Definition common_vert_edge (c1 c2 : cell) : option vert_edge:=
-  if R_eqb (right_limit c1) (left_limit c2) then
-    find (fun v => existsb (fun v' => vert_edge_eqb v v')
-                      (cell_safe_exits_left c2))
-      (cell_safe_exits_right c1)
-  else
-    find (fun v => existsb (fun v' => vert_edge_eqb v v')
-                      (cell_safe_exits_left c1))
-      (cell_safe_exits_right c2).
+Definition pop  (q : priority_queue) :
+   option (node * path node * option R * priority_queue) :=
+  match q with
+  | nil => None
+  | v :: tl => Some (v, tl)
+  end.
+
+Definition c_shortest_path cells s t :=
+  let adj := cells_to_doors_graph cells s t in
+  (adj, shortest_path node node_eqb (seq.nth [::] adj.2) 0%N 1%N _ empty
+   find update pop (iota 0 (size adj.2))).
 
 Definition midpoint (p1 p2 : pt) : pt :=
  {| p_x := R_div (R_add (p_x p1) (p_x p2)) R2;
@@ -638,38 +682,7 @@ Definition cell_center (c : cell) :=
               (seq.last dummy_pt (right_pts c))).
 
 Record annotated_point :=
-  Apt { apt_val : pt; cell_indices : seq nat}.
-
-Definition on_vert_edge (p : pt) (v : vert_edge) : bool :=
-  R_eqb (p_x p) (ve_x v) && R_ltb (ve_bot v) (p_y p) &&
-  R_ltb (p_y p) (ve_top v).
-
-(* This function assumes a straight line to the door is safe.  For annotations
-  it supposes the first cell index corresponds to the cell containing p.
-  It returns nil if there is no door, and nil or a faulty edge if
-  the other conditions are not met. *)
-Definition point_to_door (cells : seq cell) (p : annotated_point) (c1i c2i : nat) :
-   seq (annotated_point * annotated_point) :=
-let c1 := nth c1i cells dummy_cell in
-let c2 := nth c2i cells dummy_cell in
-match common_vert_edge c1 c2 with
-  Some v =>
-    if (R_eqb (p_x (apt_val p)) (ve_x v)) && negb (on_vert_edge (apt_val p) v) then
-      (p, Apt (cell_center c1) (c1i::nil)) ::
-      (Apt (cell_center c1) (c1i :: nil), Apt (vert_edge_midpoint v) (c1i :: c2i :: nil)) :: nil
-    else
-      (p, Apt (vert_edge_midpoint v) (c1i :: c2i :: nil)) :: nil
-| None => nil
-end.
-
-Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
-  List.map (fun p => (snd p, fst p)) (List.rev_append s nil).
-
-Definition strict_inside_closed p c :=
-  negb (point_under_edge p (low c)) &&
-  point_strictly_under_edge p (high c) &&
- (R_ltb (left_limit c) (p_x p) &&
- (R_ltb (p_x p) (right_limit c))).
+  Apt { apt_val : pt; door_index : option nat; cell_indices : seq nat}.
 
 Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
    (ci : nat) :=
@@ -677,178 +690,70 @@ Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
   let new_y := R_div (R_add (p_y p1) (p_y p2)) R2 in
   let new_pt := {|p_x := new_x; p_y := new_y|} in
     if strict_inside_closed new_pt c then
-      Apt new_pt (ci :: nil)
+      Apt new_pt None (ci :: nil)
     else
-      Apt (cell_center c) (ci :: nil).
-
-(* This function creates a safe path from the door between
-  c1 and c2 and the door between c2 and c3.  When op1 and op2
-  are not provided, midpoints are used as path anchors,
-  when p1 and p2 are provided they are used instead.
-  This function assumes that p1 and p2 are members of the
-  respective doors (c1-c2) and (c2-c3) *)
-Definition to_next_door (op1 op2 : option pt)
-  (cells : seq cell)
-  (c1i c2i c3i : nat) : seq (annotated_point * annotated_point) :=
-let c2 := nth c2i cells dummy_cell in
-let p1 := match op1 with
-          | Some p1 => p1
-          | None =>
-            match common_vert_edge (nth c1i cells dummy_cell) c2 with
-            | Some v => vert_edge_midpoint v
-            | None => dummy_pt
-            end
-          end in
-let p2 := match op2 with
-          | Some p2 => p2
-          | None =>
-            match common_vert_edge c2 (nth c3i cells dummy_cell) with
-            | Some v => vert_edge_midpoint v
-            | None => dummy_pt
-            end
-          end in
-if R_eqb (p_x p1) (p_x p2) then
-  let intermediate_point :=  safe_intermediate_point_in_cell p1 p2 c2 c2i in
-  (Apt p1 (c1i :: c2i :: nil), intermediate_point) ::
-  (intermediate_point, Apt p2 (c2i :: c3i :: nil)) :: nil
-else
-  (Apt p1 (c1i :: c2i :: nil), Apt p2 (c2i :: c3i :: nil)) :: nil.
-
-(* Given a sequence of cells c_i, and a sequence of indices i1, i2, ... 
-   (where the ... are refered to as tl), we want to create a list of
-   points, making it possible to move from door to door so that the all
-   all list of points is describes a broken line moving from the door
-   between i1 and i2 to the door between the last two elements of
-   (i1, i2, & tl).  Adding paths to the first and last doors will make it
-   easy to have a path from any point in cell i1 to any point in the last
-   cell of (i1, i2, & tl). when optional points are provided, they
-   are points in the first and last door. *)
-Fixpoint door_to_door (cells : seq cell)
-  (i1 i2 : nat) (opt_source opt_target : option pt)(tl : seq nat) :
-  seq (annotated_point * annotated_point) :=
-  match tl with
-  | nil => nil
-  | i3 :: nil =>
-    to_next_door opt_source opt_target cells i1 i2 i3
-  | i3 :: tl' =>
-    let tail_path := door_to_door cells i2 i3 None opt_target tl' in
-    to_next_door opt_source None cells i1 i2 i3 ++ tail_path
-  end.
+      Apt (cell_center c) None (ci :: nil).
 
-(* This function computes a path (broken line) between a point
-  in a cell and a point in another cell, going through the midpoint of
-  the door between the two cells.  the points are annotated with the
-  constraint they have to satisfied: the cells of which they have to
-  be members of. This annotation is important because smoothing will
-  replace these points with other points that have to satisfy the same
-  constraint. *)
-Definition path_adjacent_cells (cells : seq cell) (source target : pt)
-  (source_i target_i : nat) : option (seq (annotated_point * annotated_point)) :=
-  let source_cell := nth source_i cells dummy_cell in
-  let target_cell := nth target_i cells dummy_cell in
-  match common_vert_edge source_cell target_cell with
-  | Some v => 
-    Some ((Apt source (source_i :: nil), 
-           Apt (vert_edge_midpoint v) (source_i :: target_i :: nil)) ::
-              (Apt (vert_edge_midpoint v) (source_i :: target_i :: nil),
-               Apt target (target_i :: nil)) :: nil)
-  | None => None
+Definition intersection (s1 s2 : seq nat) :=
+  [seq x | x <- s1 & existsb (fun y => Nat.eqb x y) s2].
+
+Definition common_index (s1 s2 : seq nat) :=
+  let intersect := intersection s1 s2 in
+  seq.head 0 intersect.
+
+Definition door_to_annotated_point s t (d : vert_edge * nat * nat) 
+  (door_index : nat) :=
+  let p' := vert_edge_to_reference_point s t d.1.1 in
+  let annot :=
+    if Nat.eqb d.1.2 d.2 then [:: d.2] else [:: d.1.2 ; d.2] in
+  Apt p' (Some door_index) annot.
+
+Fixpoint a_shortest_path (cells : seq cell)
+  (doors : seq (vert_edge * nat * nat) * seq (seq (nat * R)))
+  s t (p : annotated_point) (path : seq node) :=
+  match path with
+  | nil => [:: p]
+  | p'i :: tlpath =>
+    let d' := seq.nth dummy_door doors.1 p'i in
+    let a_p' := door_to_annotated_point s t d' p'i in
+    if R_eqb (p_x (apt_val p)) (p_x (apt_val a_p')) then
+       let ci := common_index (cell_indices p) (cell_indices a_p') in
+       let p_extra : annotated_point := 
+         safe_intermediate_point_in_cell (apt_val p) (apt_val a_p')
+           (seq.nth dummy_cell cells ci) ci in
+       p :: p_extra :: a_shortest_path cells doors s t a_p' tlpath
+    else
+       p :: a_shortest_path cells doors s t a_p' tlpath
   end.
 
-(* find_origin_cells returns a list of cell indices. *)
-(* If the list is empty, it should mean that the point is not in the
-  safe part of the work space (it is either outside the box or on
-  one of the obstacle edges).  If the list has only one element,
-  the point is inside the indexed cell.  If the list has two
-  elements, this means that the point is in the door between the
-  two indexed cells. *)
-Definition find_origin_cells (cells : seq cell) (p : pt) : seq nat :=
-  match find (fun i => strict_inside_closed p (nth i cells dummy_cell))
-         (seq.iota 0 (List.length cells)) with
-  | Some n => n :: nil
-  | None =>
-    head nil
-    (List.map (fun av => snd av ::
-                match door_right_cell cells (fst av) with
-                | Some rc => rc :: nil
-                | None => nil
-                end)
-      (filter (fun av => on_vert_edge p (fst av)) (all_doors cells)))
+Fixpoint path_to_segments (p : annotated_point)
+   (path : seq annotated_point) : seq (annotated_point * annotated_point) :=
+  match path with
+  | nil => nil
+  | p' :: tl => (p, p') :: path_to_segments p' tl
   end.
 
-Definition intersection (s1 s2 : seq nat) :=
-  filter (fun e => existsb (fun e' => Nat.eqb e e')
-                      s2) s1.
+Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
+  List.map (fun p => (snd p, fst p)) (List.rev_append s nil).
 
-Definition point_to_point
+Definition source_to_target
  (cells : seq cell) (source target : pt) :
-  option (seq (annotated_point * annotated_point)) :=
-let source_is := find_origin_cells cells source in
-let target_is := find_origin_cells cells target in
-if Nat.ltb 0 (List.length source_is) && Nat.ltb 0 (List.length target_is) then
-  if Nat.ltb 0 (List.length (intersection source_is target_is)) then
-    Some ((Apt source source_is, Apt target target_is) :: nil)
+  option (seq (vert_edge * nat * nat) *
+          seq (annotated_point * annotated_point)) :=
+  let main := c_shortest_path cells source target in
+  let doors := main.1 in
+  let opath := main.2 in
+  let last_point := 
+     door_to_annotated_point source target
+         (seq.nth dummy_door doors.1 1) 1 in
+  if opath is Some path then
+    match a_shortest_path cells doors source target
+              last_point path with
+    | nil => None
+    | a :: tl => Some(doors.1, path_reverse (path_to_segments a tl))
+    end
   else
-    let ocp := cell_path cells (head 0%nat source_is) (head 0%nat target_is) in
-    match ocp with
-    Some cp =>
-      (* The first element of the path is (head 0 source_is), *)
-      if 2 <=? List.length cp then
-      (* looking
-         at a length larger than 2 actually means the path has at least 3 fenceposts
-         and at least 2 intervals:
-         head source_is (nth 0 cp 0)  (nth 1 cp 0)
-         so there are (at least) 2 doors. *)
-        if existsb (Nat.eqb (nth 0 cp 0%nat)) source_is then
-        (* It can only be the case that the source is on a door, and
-         that the two cells concerned with the first hop are the
-         two cells of this door.  In this case, there is no need
-         to draw a first path element from from the source point to the
-         vertical edge midpoint, since the first point is already
-         on the door, and that the target is not in the second cell
-         of the path, so the length of cp is strictly larger than 2 *)
-           if existsb (Nat.eqb (nth (List.length cp - 2) cp 0%nat)) target_is then
-             (* Here target_is is in the penultimate cell of the path *)
-             Some (door_to_door cells (head 0%nat source_is) (nth 0 cp 0%nat)
-                 (Some source) (Some target) (seq.behead cp (* (seq.behead cp) *)))
-           else
-             Some (door_to_door cells (head 0%nat source_is) (nth 0 cp 0%nat) (Some source) None
-                 (seq.behead cp) ++
-                 path_reverse (point_to_door cells (Apt target target_is)
-                    (nth (List.length cp - 1) cp 0%nat)
-                    (nth (List.length cp - 2) cp 0%nat)))
-        else
-          if existsb (Nat.eqb (nth ((List.length cp) - 2) cp 0%nat)) target_is then
-             Some ((point_to_door cells (Apt source source_is) (head 0%nat source_is)
-                        (nth 0 cp 0%nat)) ++
-             door_to_door cells (head 0%nat source_is) (nth 0 cp 0%nat) None (Some target)
-                 (seq.behead cp))
-          else
-             Some (point_to_door cells (Apt source source_is) (head 0%nat source_is) (nth 0 cp 0%nat) ++
-             door_to_door cells (head 0%nat source_is) (nth 0 cp 0%nat) None None
-                 (seq.behead cp) ++
-                 path_reverse (point_to_door cells (Apt target target_is)
-                    (nth (List.length cp - 1) cp 0%nat)
-                    (nth (List.length cp - 2) cp 0%nat)))
-      else
-      (* if cp has length 1, then there is only one door. if one of the
-         point is on the door, it can be connected to the other, *)
-         match common_vert_edge (nth (head 0%nat source_is) cells dummy_cell)
-                                (nth (head 0%nat target_is) cells dummy_cell) with
-         | Some v =>
-           if on_vert_edge source v || on_vert_edge target v then
-              Some ((Apt source source_is, Apt target target_is) :: nil)
-           else
-              Some (point_to_door cells (Apt source source_is) (head 0%nat source_is)
-                 (head 0%nat target_is) ++
-                   path_reverse (point_to_door cells (Apt target target_is)
-                        (head 0%nat source_is) (head 0%nat target_is)))
-         | None => None
-         end
-  | None => None
-  end
-else
-None.
+    None.
 
 (* THIRD PART: Producing a smooth trajectory. *)
 (* We produce a smooth trajectory by replacing every angle by a Bezier curve.
@@ -866,9 +771,9 @@ None.
 Fixpoint break_segments (s : seq (annotated_point * annotated_point)) :
   seq (annotated_point * annotated_point) :=
   match s with
-  | (Apt p1 a1, Apt p2 a2) :: tl =>
-    (Apt p1 a1, Apt (midpoint p1 p2) (intersection a1 a2)) ::
-    (Apt (midpoint p1 p2) (intersection a1 a2), Apt p2 a2) ::
+  | (Apt p1 door_index1 a1, Apt p2 door_index2 a2) :: tl =>
+    (Apt p1 door_index1 a1, Apt (midpoint p1 p2) None (intersection a1 a2)) ::
+    (Apt (midpoint p1 p2) None (intersection a1 a2), Apt p2 door_index2 a2) ::
         break_segments tl
   | nil => nil
   end. 
@@ -1005,19 +910,14 @@ end.
 Definition fuel_constant := 20.
 
 Fixpoint check_curve_element_and_repair
-  (fuel : nat) (cells : seq cell) (e : curve_element) :
+  (fuel : nat) doors (e : curve_element) :
    seq curve_element :=
 match e with
 | straight p1 p2 => straight p1 p2 :: nil
 | bezier p1 p2 p3 =>
-  if Nat.eqb (List.length (cell_indices p2)) 2 then
-    let i1 := nth 0 (cell_indices p2) 0%nat in
-    let i2 := nth 1 (cell_indices p2) 0%nat in
-    let vedge := match common_vert_edge 
-         (nth i1 cells dummy_cell) (nth i2 cells dummy_cell) with
-      Some v => v
-      | None => dummy_vert_edge
-      end in
+  if door_index p2 is Some n then
+    let vedge :=
+       (seq.nth dummy_door doors n).1.1 in
     let e' :=
       (if R_ltb (p_x (apt_val p1)) (p_x (apt_val p2)) then
         bezier p1 p2 p3
@@ -1039,16 +939,17 @@ match e with
           match fuel with
           | S p =>
             straight p1 
-               (Apt (midpoint (apt_val p1) (apt_val p2)) (cell_indices p1))
+               (Apt (midpoint (apt_val p1) (apt_val p2)) 
+                    None (cell_indices p1))
               ::
-              check_curve_element_and_repair p cells
-                (bezier (Apt (midpoint (apt_val p1) (apt_val p2))
+              check_curve_element_and_repair p doors
+                (bezier (Apt (midpoint (apt_val p1) (apt_val p2)) None
                        (cell_indices p1))
                  p2
-                 (Apt (midpoint (apt_val p2) (apt_val p3)) (cell_indices p3)))
+                 (Apt (midpoint (apt_val p2) (apt_val p3)) None (cell_indices p3)))
               ++
               straight (Apt (midpoint (apt_val p2) (apt_val p3))
-                    (cell_indices p3)) p3 :: nil
+                    None (cell_indices p3)) p3 :: nil
           | _ =>
             straight p1 p2 :: straight p2 p3 :: nil
           end
@@ -1060,9 +961,9 @@ end.
 
 Definition smooth_from_cells (cells : seq cell)
   (initial final : pt) : seq curve_element :=
-  match point_to_point cells initial final with
-  | Some s => List.concat
-       (List.map (check_curve_element_and_repair fuel_constant cells)
+  match source_to_target cells initial final with
+  | Some (doors, s) => List.concat
+       (List.map (check_curve_element_and_repair fuel_constant doors)
                               (smoothen (break_segments s)))
   | None => nil
   end.
diff --git a/theories/smooth_trajectories.v b/theories/smooth_trajectories.v
index be6af09..c680012 100644
--- a/theories/smooth_trajectories.v
+++ b/theories/smooth_trajectories.v
@@ -1,6 +1,7 @@
 From mathcomp Require Import all_ssreflect.
 Require Import ZArith QArith List String OrderedType OrderedTypeEx FMapAVL.
 Require Import generic_trajectories.
+Require Import Qabs.
 
 Definition Qlt_bool x y := andb (negb (Qeq_bool x y)) (Qle_bool x y).
 
@@ -27,9 +28,14 @@ Definition scan :=
   complete_process Q Qeq_bool Qle_bool 
     Qplus Qminus Qmult Qdiv 0 edge Bedge left_pt right_pt.
 
+Definition manhattan_distance (p1x p1y p2x p2y : R) :=
+  Qabs (p2x - p1x) + Qabs (p2y - p1y).
+
+Definition pt_distance := manhattan_distance.
+
 Definition Qsmooth_point_to_point :=
  smooth_point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
-   1 edge Bedge left_pt right_pt.
+   pt_distance 1 edge Bedge left_pt right_pt.
 
 Definition Qedges_to_cells :=
    edges_to_cells Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv 1
@@ -190,7 +196,7 @@ Definition display_smooth_trajectory (tr_x tr_y scale : Q)
 "stroke"%string :: nil).
 
 Definition Qsmooth_from_cells :=
-  smooth_from_cells Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv 1 edge
+  smooth_from_cells Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv pt_distance 1 edge
   Bedge left_pt right_pt.
 
 Definition display_full_example tr_x tr_y scale
@@ -295,6 +301,7 @@ Definition leftmost_points :=
    that have a vertical left edge have a neighbor on their left
    that has the same vertical edge on the right. *)
 
+(*
 Lemma all_cells_have_left_neighbor :
   forallb (fun edge_list =>
   let cells := Qedges_to_cells example_bottom example_top edge_list in
@@ -305,7 +312,8 @@ Lemma all_cells_have_left_neighbor :
             (existsb (fun c' => lr_connected Q Qeq_bool 1 edge c' c) cells))) cells)
         example_edge_sets = true.
 Proof. easy. Qed.
-
+*)
+(*
 Definition reference_line edge_list p1 p2 :=
    ("[4 4] 0 setdash 3 setlinewidth"%string ::
    (List.map (fun sg => display_segment 300 400 70 (apt_val (fst sg), apt_val (snd sg)))
@@ -315,7 +323,8 @@ Definition reference_line edge_list p1 p2 :=
    Some l => l
    | None => nil
    end ++ "stroke %debug"%string :: nil)).
-
+*)
+(*
 Definition example_test edge_list (p1 p2 : pt) (extra : seq string) :=
   display_full_example 300 400 70 example_bottom example_top
     edge_list p1 p2 extra.
@@ -329,7 +338,7 @@ Definition example_by_index edge_list_index point_pair_index (with_dotted_line :
      reference_line edge_list (fst pp) (snd pp)
    else
      nil).
-
+*)
 (* To display a more elaborate example that shows in a curved dash line
   the result of smoothening the trajectory without repaing, you can
   execute the following text.
@@ -408,3 +417,12 @@ Compute edges_to_events example_edge_list.
 *)
 
 (* Compute example_by_index 0 0 false. *)
+
+(* Definition approx_sqrt  *)
+
+(*
+Definition euclidean_distance (p1 p2 : pt) :=
+   (p_x p2 - p_x p1) ^ 2 + (p_y p2 - p_y p1) ^ 2.
+
+*)
+

From 2f4285fedf5191fd3274685d371f158ef400ba97 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Thu, 25 Apr 2024 04:33:21 +0200
Subject: [PATCH 18/43] silence

---
 www/Add.ml | 403 -----------------------------------------------------
 1 file changed, 403 deletions(-)
 delete mode 100644 www/Add.ml

diff --git a/www/Add.ml b/www/Add.ml
deleted file mode 100644
index c94be3b..0000000
--- a/www/Add.ml
+++ /dev/null
@@ -1,403 +0,0 @@
-
-type nat =
-| O
-| S of nat
-
-type ('a, 'b) prod =
-| Pair of 'a * 'b
-
-(** val snd : ('a1, 'a2) prod -> 'a2 **)
-
-let snd = function
-| Pair (_, y) -> y
-
-type 'a list =
-| Nil
-| Cons of 'a * 'a list
-
-type comparison =
-| Eq
-| Lt
-| Gt
-
-module Coq__1 = struct
- (** val add : nat -> nat -> nat **)
- let rec add n m =
-   match n with
-   | O -> m
-   | S p -> S (add p m)
-end
-include Coq__1
-
-type positive =
-| XI of positive
-| XO of positive
-| XH
-
-type z =
-| Z0
-| Zpos of positive
-| Zneg of positive
-
-module Pos =
- struct
-  type mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
- end
-
-module Coq_Pos =
- struct
-  (** val succ : positive -> positive **)
-
-  let rec succ = function
-  | XI p -> XO (succ p)
-  | XO p -> XI p
-  | XH -> XO XH
-
-  (** val add : positive -> positive -> positive **)
-
-  let rec add x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XI (add p q0)
-       | XO q0 -> XO (add p q0)
-       | XH -> XI p)
-    | XH -> (match y with
-             | XI q0 -> XO (succ q0)
-             | XO q0 -> XI q0
-             | XH -> XO XH)
-
-  (** val add_carry : positive -> positive -> positive **)
-
-  and add_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XI (add_carry p q0)
-       | XO q0 -> XO (add_carry p q0)
-       | XH -> XI (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XH ->
-      (match y with
-       | XI q0 -> XI (succ q0)
-       | XO q0 -> XO (succ q0)
-       | XH -> XI XH)
-
-  (** val pred_double : positive -> positive **)
-
-  let rec pred_double = function
-  | XI p -> XI (XO p)
-  | XO p -> XI (pred_double p)
-  | XH -> XH
-
-  type mask = Pos.mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
-
-  (** val succ_double_mask : mask -> mask **)
-
-  let succ_double_mask = function
-  | IsNul -> IsPos XH
-  | IsPos p -> IsPos (XI p)
-  | IsNeg -> IsNeg
-
-  (** val double_mask : mask -> mask **)
-
-  let double_mask = function
-  | IsPos p -> IsPos (XO p)
-  | x0 -> x0
-
-  (** val double_pred_mask : positive -> mask **)
-
-  let double_pred_mask = function
-  | XI p -> IsPos (XO (XO p))
-  | XO p -> IsPos (XO (pred_double p))
-  | XH -> IsNul
-
-  (** val sub_mask : positive -> positive -> mask **)
-
-  let rec sub_mask x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask p q0)
-       | XO q0 -> succ_double_mask (sub_mask p q0)
-       | XH -> IsPos (XO p))
-    | XO p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XH -> (match y with
-             | XH -> IsNul
-             | _ -> IsNeg)
-
-  (** val sub_mask_carry : positive -> positive -> mask **)
-
-  and sub_mask_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XO p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask_carry p q0)
-       | XO q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XH -> double_pred_mask p)
-    | XH -> IsNeg
-
-  (** val sub : positive -> positive -> positive **)
-
-  let sub x y =
-    match sub_mask x y with
-    | IsPos z0 -> z0
-    | _ -> XH
-
-  (** val mul : positive -> positive -> positive **)
-
-  let rec mul x y =
-    match x with
-    | XI p -> add y (XO (mul p y))
-    | XO p -> XO (mul p y)
-    | XH -> y
-
-  (** val size_nat : positive -> nat **)
-
-  let rec size_nat = function
-  | XI p0 -> S (size_nat p0)
-  | XO p0 -> S (size_nat p0)
-  | XH -> S O
-
-  (** val compare_cont : comparison -> positive -> positive -> comparison **)
-
-  let rec compare_cont r x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> compare_cont r p q0
-       | XO q0 -> compare_cont Gt p q0
-       | XH -> Gt)
-    | XO p ->
-      (match y with
-       | XI q0 -> compare_cont Lt p q0
-       | XO q0 -> compare_cont r p q0
-       | XH -> Gt)
-    | XH -> (match y with
-             | XH -> r
-             | _ -> Lt)
-
-  (** val compare : positive -> positive -> comparison **)
-
-  let compare =
-    compare_cont Eq
-
-  (** val ggcdn :
-      nat -> positive -> positive -> (positive, (positive, positive) prod)
-      prod **)
-
-  let rec ggcdn n a b =
-    match n with
-    | O -> Pair (XH, (Pair (a, b)))
-    | S n0 ->
-      (match a with
-       | XI a' ->
-         (match b with
-          | XI b' ->
-            (match compare a' b' with
-             | Eq -> Pair (a, (Pair (XH, XH)))
-             | Lt ->
-               let Pair (g, p) = ggcdn n0 (sub b' a') a in
-               let Pair (ba, aa) = p in
-               Pair (g, (Pair (aa, (add aa (XO ba)))))
-             | Gt ->
-               let Pair (g, p) = ggcdn n0 (sub a' b') b in
-               let Pair (ab, bb) = p in
-               Pair (g, (Pair ((add bb (XO ab)), bb))))
-          | XO b0 ->
-            let Pair (g, p) = ggcdn n0 a b0 in
-            let Pair (aa, bb) = p in Pair (g, (Pair (aa, (XO bb))))
-          | XH -> Pair (XH, (Pair (a, XH))))
-       | XO a0 ->
-         (match b with
-          | XI _ ->
-            let Pair (g, p) = ggcdn n0 a0 b in
-            let Pair (aa, bb) = p in Pair (g, (Pair ((XO aa), bb)))
-          | XO b0 -> let Pair (g, p) = ggcdn n0 a0 b0 in Pair ((XO g), p)
-          | XH -> Pair (XH, (Pair (a, XH))))
-       | XH -> Pair (XH, (Pair (XH, b))))
-
-  (** val ggcd :
-      positive -> positive -> (positive, (positive, positive) prod) prod **)
-
-  let ggcd a b =
-    ggcdn (Coq__1.add (size_nat a) (size_nat b)) a b
- end
-
-module Z =
- struct
-  (** val double : z -> z **)
-
-  let double = function
-  | Z0 -> Z0
-  | Zpos p -> Zpos (XO p)
-  | Zneg p -> Zneg (XO p)
-
-  (** val succ_double : z -> z **)
-
-  let succ_double = function
-  | Z0 -> Zpos XH
-  | Zpos p -> Zpos (XI p)
-  | Zneg p -> Zneg (Coq_Pos.pred_double p)
-
-  (** val pred_double : z -> z **)
-
-  let pred_double = function
-  | Z0 -> Zneg XH
-  | Zpos p -> Zpos (Coq_Pos.pred_double p)
-  | Zneg p -> Zneg (XI p)
-
-  (** val pos_sub : positive -> positive -> z **)
-
-  let rec pos_sub x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> double (pos_sub p q0)
-       | XO q0 -> succ_double (pos_sub p q0)
-       | XH -> Zpos (XO p))
-    | XO p ->
-      (match y with
-       | XI q0 -> pred_double (pos_sub p q0)
-       | XO q0 -> double (pos_sub p q0)
-       | XH -> Zpos (Coq_Pos.pred_double p))
-    | XH ->
-      (match y with
-       | XI q0 -> Zneg (XO q0)
-       | XO q0 -> Zneg (Coq_Pos.pred_double q0)
-       | XH -> Z0)
-
-  (** val add : z -> z -> z **)
-
-  let add x y =
-    match x with
-    | Z0 -> y
-    | Zpos x' ->
-      (match y with
-       | Z0 -> x
-       | Zpos y' -> Zpos (Coq_Pos.add x' y')
-       | Zneg y' -> pos_sub x' y')
-    | Zneg x' ->
-      (match y with
-       | Z0 -> x
-       | Zpos y' -> pos_sub y' x'
-       | Zneg y' -> Zneg (Coq_Pos.add x' y'))
-
-  (** val mul : z -> z -> z **)
-
-  let mul x y =
-    match x with
-    | Z0 -> Z0
-    | Zpos x' ->
-      (match y with
-       | Z0 -> Z0
-       | Zpos y' -> Zpos (Coq_Pos.mul x' y')
-       | Zneg y' -> Zneg (Coq_Pos.mul x' y'))
-    | Zneg x' ->
-      (match y with
-       | Z0 -> Z0
-       | Zpos y' -> Zneg (Coq_Pos.mul x' y')
-       | Zneg y' -> Zpos (Coq_Pos.mul x' y'))
-
-  (** val sgn : z -> z **)
-
-  let sgn = function
-  | Z0 -> Z0
-  | Zpos _ -> Zpos XH
-  | Zneg _ -> Zneg XH
-
-  (** val abs : z -> z **)
-
-  let abs = function
-  | Zneg p -> Zpos p
-  | x -> x
-
-  (** val to_pos : z -> positive **)
-
-  let to_pos = function
-  | Zpos p -> p
-  | _ -> XH
-
-  (** val ggcd : z -> z -> (z, (z, z) prod) prod **)
-
-  let ggcd a b =
-    match a with
-    | Z0 -> Pair ((abs b), (Pair (Z0, (sgn b))))
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
-       | Zpos b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zpos aa), (Zpos bb))))
-       | Zneg b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zpos aa), (Zneg bb)))))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> Pair ((abs a), (Pair ((sgn a), Z0)))
-       | Zpos b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zneg aa), (Zpos bb))))
-       | Zneg b0 ->
-         let Pair (g, p) = Coq_Pos.ggcd a0 b0 in
-         let Pair (aa, bb) = p in
-         Pair ((Zpos g), (Pair ((Zneg aa), (Zneg bb)))))
- end
-
-type q = { qnum : z; qden : positive }
-
-(** val qplus : q -> q -> q **)
-
-let qplus x y =
-  { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
-    qden = (Coq_Pos.mul x.qden y.qden) }
-
-(** val qred : q -> q **)
-
-let qred q0 =
-  let { qnum = q1; qden = q2 } = q0 in
-  let Pair (r1, r2) = snd (Z.ggcd q1 (Zpos q2)) in
-  { qnum = r1; qden = (Z.to_pos r2) }
-
-(** val a_val : q list **)
-
-let a_val =
-  Cons ({ qnum = (Zpos XH); qden = XH }, Nil)
-
-(** val sum_val_rec : q list -> q **)
-
-let rec sum_val_rec = function
-| Nil -> { qnum = Z0; qden = XH }
-| Cons (a, l0) -> qred (qplus a (sum_val_rec l0))
-
-(** val sum_val : q list -> q list **)
-
-let sum_val l =
-  Cons ((sum_val_rec l), Nil)

From ad6ab0d3e839fe2c9c4d8bcc92edbe27aea8f866 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Thu, 25 Apr 2024 06:53:15 +0200
Subject: [PATCH 19/43] first attempt at correcting the bugs when extremities
 are on doors

---
 theories/generic_trajectories.v | 56 ++++++++++++++++++---------------
 1 file changed, 31 insertions(+), 25 deletions(-)

diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 811c9ed..99e34ab 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -554,9 +554,11 @@ Definition vert_edge_to_reference_point (s t : pt) (v : vert_edge) :=
   else if on_vert_edge t v then t
   else vert_edge_midpoint v.
 
+Definition door := (vert_edge * nat * nat)%type.
+
 Definition one_door_neighbors
-  (indexed_doors : seq (nat * (vert_edge * nat * nat)))
-  (i_d : nat * (vert_edge * nat * nat)) : list nat :=
+  (indexed_doors : seq (nat * door))
+  (i_d : nat * door) : list nat :=
   match i_d with
   | (j, (v0, i0, i'0)) =>
     map fst
@@ -577,22 +579,26 @@ Definition strict_inside_closed p c :=
 
 Definition add_extremity_reference_point
   (indexed_cells : seq (nat * cell))
-  (doors : seq (vert_edge * nat * nat)) (p : pt) :=
-  if existsb (fun '(v, _, _) => on_vert_edge p v) doors then
-    [::]
+  (p : pt) (doors : seq door) :=
+  let purported_index :=
+    seq.find (fun '(v, _, _) => on_vert_edge p v) doors in
+  if purported_index < size doors then
+    (doors, purported_index)
   else 
     let '(i, c) :=
       head (size indexed_cells, dummy_cell)
         (filter (fun '(i', c') => strict_inside_closed p c')  indexed_cells) in
-      [:: ({|ve_x := p_x p; ve_top := p_y p; ve_bot := p_y p|}, i, i)].
+      (rcons doors ({|ve_x := p_x p; ve_top := p_y p; ve_bot := p_y p|}, i, i), size doors).
 
 Definition doors_and_extremities (indexed_cells : seq (nat * cell))
-  (doors : seq (vert_edge * nat * nat)) (s t : pt) :=
-  add_extremity_reference_point indexed_cells doors s ++
-  add_extremity_reference_point indexed_cells doors t ++
-  doors.
-
-Definition door_adjacency_map (doors : seq (vert_edge * nat * nat)) :
+  (doors : seq door) (s t : pt) : seq door * nat * nat :=
+  let '(d_s, i_s) := 
+     add_extremity_reference_point indexed_cells s doors in
+  let '(d_t, i_t) :=
+     add_extremity_reference_point indexed_cells t d_s in
+  (d_t, i_s, i_t).
+
+Definition door_adjacency_map (doors : seq door) :
   seq (seq nat) :=
   let indexed_doors := index_seq doors in
   map (fun i_d => one_door_neighbors indexed_doors i_d) indexed_doors.
@@ -602,7 +608,7 @@ Definition dummy_vert_edge :=
 
 Definition dummy_door := (dummy_vert_edge, 0, 0).
 
-Definition distance (doors : seq (vert_edge * nat * nat)) (s t : pt) 
+Definition distance (doors : seq door) (s t : pt) 
   (i j : nat) :=
   let '(v1, _, _) := seq.nth dummy_door doors i in
   let '(v2, _, _) := seq.nth dummy_door doors j in
@@ -613,13 +619,13 @@ Definition distance (doors : seq (vert_edge * nat * nat)) (s t : pt)
 Definition cells_to_doors_graph (cells : seq cell) (s t : pt) :=
   let regular_doors := cells_to_doors cells in
   let indexed_cells := index_seq cells in
-  let full_seq_of_doors :=
+  let '(full_seq_of_doors, i_s, i_t) :=
     doors_and_extremities indexed_cells regular_doors s t in
   let adj_map := door_adjacency_map full_seq_of_doors in
   let neighbors_and_distances :=
     [seq [seq (j, distance full_seq_of_doors s t i j) | j <- neighbors]
         | '(i, neighbors) <- index_seq adj_map] in
-      (full_seq_of_doors, neighbors_and_distances).
+      (full_seq_of_doors, neighbors_and_distances, i_s, i_t).
 
 Definition node := nat.
 
@@ -666,9 +672,10 @@ Definition pop  (q : priority_queue) :
   end.
 
 Definition c_shortest_path cells s t :=
-  let adj := cells_to_doors_graph cells s t in
-  (adj, shortest_path node node_eqb (seq.nth [::] adj.2) 0%N 1%N _ empty
-   find update pop (iota 0 (size adj.2))).
+  let '(adj, i_s, i_t) := cells_to_doors_graph cells s t in
+  (adj, shortest_path node node_eqb (seq.nth [::] adj.2) i_s
+    i_t _ empty
+   find update pop (iota 0 (size adj.2)), i_s, i_t).
 
 Definition midpoint (p1 p2 : pt) : pt :=
  {| p_x := R_div (R_add (p_x p1) (p_x p2)) R2;
@@ -701,7 +708,7 @@ Definition common_index (s1 s2 : seq nat) :=
   let intersect := intersection s1 s2 in
   seq.head 0 intersect.
 
-Definition door_to_annotated_point s t (d : vert_edge * nat * nat) 
+Definition door_to_annotated_point s t (d : door) 
   (door_index : nat) :=
   let p' := vert_edge_to_reference_point s t d.1.1 in
   let annot :=
@@ -709,7 +716,7 @@ Definition door_to_annotated_point s t (d : vert_edge * nat * nat)
   Apt p' (Some door_index) annot.
 
 Fixpoint a_shortest_path (cells : seq cell)
-  (doors : seq (vert_edge * nat * nat) * seq (seq (nat * R)))
+  (doors : seq door * seq (seq (nat * R)))
   s t (p : annotated_point) (path : seq node) :=
   match path with
   | nil => [:: p]
@@ -738,14 +745,13 @@ Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
 
 Definition source_to_target
  (cells : seq cell) (source target : pt) :
-  option (seq (vert_edge * nat * nat) *
+  option (seq door *
           seq (annotated_point * annotated_point)) :=
-  let main := c_shortest_path cells source target in
-  let doors := main.1 in
-  let opath := main.2 in
+  let '(doors, opath, i_s, i_t) :=
+       c_shortest_path cells source target in
   let last_point := 
      door_to_annotated_point source target
-         (seq.nth dummy_door doors.1 1) 1 in
+         (seq.nth dummy_door doors.1 i_t) i_t in
   if opath is Some path then
     match a_shortest_path cells doors source target
               last_point path with

From f9342d1a18e2e715661b9bab629607411807697b Mon Sep 17 00:00:00 2001
From: thery <Laurent.Thery@inria.fr>
Date: Thu, 25 Apr 2024 07:26:01 +0200
Subject: [PATCH 20/43] remove unnecessary files

---
 www/Add.html           |  30 --------
 www/AddScript.js       |   4 -
 www/Makefile.coq.local |  40 +++-------
 www/add.v              |  13 ----
 www/curve.html         |  27 -------
 www/jAdd.ml            |  57 --------------
 www/jAdd.mli           |   6 --
 www/script.js          | 171 -----------------------------------------
 8 files changed, 9 insertions(+), 339 deletions(-)
 delete mode 100755 www/Add.html
 delete mode 100644 www/AddScript.js
 delete mode 100755 www/curve.html
 delete mode 100644 www/jAdd.ml
 delete mode 100644 www/jAdd.mli
 delete mode 100644 www/script.js

diff --git a/www/Add.html b/www/Add.html
deleted file mode 100755
index aefc4fa..0000000
--- a/www/Add.html
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-<HTML>
-
-    <HEAD>
-
-        <TITLE>Add</TITLE>
-
-    </HEAD><BODY>
-
-        <H1> Add </H1>
-       
-        <p>
-	        <script src="Add.js"></script>
-	        <script src="AddScript.js"></script>
-  </div>
-  <div>
-    <textarea id="text" name="text"
-          rows="1" cols="33">
-1 2 1 2 
-</textarea>
-<p>
-  <button onclick="myadd()" class="Clear"> Test </button>
- </div>
-</div>
-        </p>
-
-    </BODY>
-
-</HTML>
diff --git a/www/AddScript.js b/www/AddScript.js
deleted file mode 100644
index eee5860..0000000
--- a/www/AddScript.js
+++ /dev/null
@@ -1,4 +0,0 @@
-function myadd() {
-  let v = document.getElementById("text").value;
- window.alert(add(v));
-}
diff --git a/www/Makefile.coq.local b/www/Makefile.coq.local
index 7083bfd..7b0ca27 100644
--- a/www/Makefile.coq.local
+++ b/www/Makefile.coq.local
@@ -1,25 +1,12 @@
 post-all::
-	$(MAKE) -f $(SELF) Add.mli SmoothTrajectories.mli
-clean::
-	rm -f Add.mli
-
-Add.mli : add.vo
-	echo "mli"
-post-all::
-		$(MAKE) -f $(SELF) Add.ml
-clean::
-		rm -f Add.ml
-Add.ml : add.vo
-		echo "ml"
+	$(MAKE) -f $(SELF) SmoothTrajectories.mli
 
 post-all::
-	$(MAKE) -f $(SELF) Add.cmi SmoothTrajectories.cmi
+	$(MAKE) -f $(SELF) SmoothTrajectories.cmi
 
 clean::
-	rm -f Add.cmi Add.cmo jAdd.cmi jAdd.cmo SmoothTrajectories.cmi SmoothTrajectories.cmo jSmoothTrajectories.cmi jSmoothTrajectories.cmo
+	rm -f SmoothTrajectories.cmi SmoothTrajectories.cmo jSmoothTrajectories.cmi jSmoothTrajectories.cmo
 
-Add.cmi : Add.mli
-	ocamlfind ocamlc Add.mli
 
 SmoothTrajectories.ml SmoothTrajectories.mli : ../theories/smooth_trajectories.vo
 	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
@@ -29,34 +16,25 @@ SmoothTrajectories.cmi : SmoothTrajectories.mli
 	ocamlfind ocamlc SmoothTrajectories.mli
 
 post-all::
-	$(MAKE) -f $(SELF) jAdd.cmi jSmoothTrajectories.cmi
+	$(MAKE) -f $(SELF) jSmoothTrajectories.cmi
 clean::
-	rm -f jAdd.cmi jSmoothTrajectories.cmi
-
-jAdd.cmi :  jAdd.ml
-	ocamlfind ocamlc jAdd.mli
+	rm -f jSmoothTrajectories.cmi
 
 jSmoothTrajectories.cmi :  jSmoothTrajectories.ml
 	ocamlfind ocamlc jSmoothTrajectories.mli
 
 post-all::
-	$(MAKE) -f $(SELF) Add.bytes SmoothTrajectories.bytes
+	$(MAKE) -f $(SELF) SmoothTrajectories.bytes
 clean::
-	rm -f Add.bytes SmoothTrajectories.bytes
-
-Add.bytes :  jAdd.cmi jAdd.ml Add.ml Add.cmi
-	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o Add.bytes Add.ml jAdd.ml
+	rm -f SmoothTrajectories.bytes
 
 SmoothTrajectories.bytes :  jSmoothTrajectories.cmi jSmoothTrajectories.ml SmoothTrajectories.ml SmoothTrajectories.cmi
 	ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o SmoothTrajectories.bytes SmoothTrajectories.ml jSmoothTrajectories.ml
 
 post-all::
-	$(MAKE) -f $(SELF) Add.js SmoothTrajectories.js
+	$(MAKE) -f $(SELF) SmoothTrajectories.js
 clean::
-	rm -f Add.js SmoothTrajectories.js
-
-Add.js :  Add.bytes
-	js_of_ocaml Add.bytes
+	rm -f SmoothTrajectories.js
 
 SmoothTrajectories.js :  SmoothTrajectories.bytes
 	js_of_ocaml --opt=3 SmoothTrajectories.bytes
diff --git a/www/add.v b/www/add.v
index 0d36de6..8b13789 100644
--- a/www/add.v
+++ b/www/add.v
@@ -1,14 +1 @@
-Require Import List QArith Extraction.
-
-
-Definition a_val := 1%Q :: nil.
-
-Fixpoint sum_val_rec l :=
- match l with a :: l =>     Qred (a + sum_val_rec l)%Q | _ => 0%Q end.
-
-Definition sum_val l := (sum_val_rec l) :: nil.
-
-Compute sum_val ((1#2)%Q :: (1#2)%Q :: nil).
-
-Extraction "Add.ml" a_val sum_val.
 
diff --git a/www/curve.html b/www/curve.html
deleted file mode 100755
index 6de55e6..0000000
--- a/www/curve.html
+++ /dev/null
@@ -1,27 +0,0 @@
-<html>
-	<head>
-		<meta charset="utf-8">
-		<title>Curve</title>
-    <style>
-      body {
-              overflow: hidden;
-              margin: 0px;
-           }
-    </style>
-    <script async
-      src="https://unpkg.com/es-module-shims@1.6.3/dist/es-module-shims.js">
-    </script>
-
-    <script type="importmap">
-      {
-        "imports": {
-        "three": "https://unpkg.com/three@0.150.1/build/three.module.js",
-        "three/addons/": "https://unpkg.com/three@0.150.1/examples/jsm/"
-        }
-      }
-    </script>
-	</head>
-  <body>
-  <script defer type="module" src="./script.js"></script>
-  </body>
-</html>
\ No newline at end of file
diff --git a/www/jAdd.ml b/www/jAdd.ml
deleted file mode 100644
index a57188e..0000000
--- a/www/jAdd.ml
+++ /dev/null
@@ -1,57 +0,0 @@
-(** link code **)
-
-open Js_of_ocaml
-open Add
-
-let rec n2pos n = if n < 2 then XH else 
-                  if n mod 2 == 0 then 
-                  XO (n2pos (n / 2)) else XI (n2pos (n / 2))
-
-let rec pos2n n = 
-  match n with XH -> 1 | XO n -> 2 * (pos2n n) | XI n -> 2 * (pos2n n) + 1
-
-let n2z n = if n = 0 then Z0 else 
-            if 0 < n then Zpos (n2pos n)
-            else Zneg (n2pos n)
-
-let z2n n = match n with
-| Z0 -> 0
-| Zpos n -> pos2n n
-| Zneg n -> - pos2n n
-
-let string2lr s =
-  let le = String.length s in
-  let rec iter i si vi = if i = le then Nil else
-    let v = String.get s i in 
-    if (v == '-') then iter (i + 1) (-1) vi else
-    if (v == '+') then iter (i + 1) (1) vi else
-    if (v == ' ') then Cons (n2z (si * vi), iter (i + 1) 1 0) else
-    iter (i + 1) si (vi * 10 + (Char.code v - 48)) in
-  iter 0 1 0
-
-let rec string2lr1 l = 
-match l with 
-| Cons (n , Cons (Z0, l)) -> Cons ({qnum = n; qden = XH}, (string2lr1 l))
-| Cons (n, Cons (Zpos d, l)) -> Cons ({qnum = n; qden = d}, (string2lr1 l))
-| _ -> Nil
-
-let string2l s = string2lr1 (string2lr s)
-
-let rec l2stringr s l =
-  match l with
-    Nil -> s
-  | Cons (n,l) ->  l2stringr (s ^ (string_of_int (z2n n.qnum)) ^ " " ^
-                                  (string_of_int (pos2n n.qden)) ^ " ")
-                             l
-
-let l2string l = l2stringr "" l
-
-let main s =
-  let l = string2l s in l2string (sum_val l)
-
-let _ =
-  Js.export_all
-    (object%js
-      method add s = Js.string (main (Js.to_string s))
-    end)
-
diff --git a/www/jAdd.mli b/www/jAdd.mli
deleted file mode 100644
index 2fe4da4..0000000
--- a/www/jAdd.mli
+++ /dev/null
@@ -1,6 +0,0 @@
-open Add
-
-val n2pos : int -> positive
-val pos2n : positive -> int
-val n2z : int -> z
-val z2n : z -> int
diff --git a/www/script.js b/www/script.js
deleted file mode 100644
index a0e24cb..0000000
--- a/www/script.js
+++ /dev/null
@@ -1,171 +0,0 @@
-import * as THREE from 'three';
-import { FontLoader } from 'three/addons/loaders/FontLoader.js';
-import { TextGeometry } from 'three/addons/geometries/TextGeometry.js';
-
-const renderer = new THREE.WebGLRenderer();
-renderer.setSize( window.innerWidth, window.innerHeight );
-document.body.appendChild( renderer.domElement );
-
-const camera = new THREE.PerspectiveCamera( 45, window.innerWidth / window.innerHeight, 1, 500 );
-camera.position.set( 0, 0, 10 );
-camera.lookAt( 0, 0, 0 );
-
-const scene = new THREE.Scene();
-scene.background = new THREE.Color( 'lightgrey' );
-
-//create a blue LineBasicMaterial
-const material = new THREE.LineBasicMaterial( { color: 'black' } );
-const cmaterial = new THREE.LineBasicMaterial( { color: 'red' } );
-
-/* 
-BOTTOM
-  ({| left_pt := {| p_x := -4; p_y := -4|};
-      right_pt := {| p_x := 4; p_y := -4|}|}).
-
-*/
-
-const bpoints = [];
-bpoints.push( new THREE.Vector3( - 4, - 4, 0 ) );
-bpoints.push( new THREE.Vector3(   4, - 4, 0 ) );
-
-const bgeometry = new THREE.BufferGeometry().setFromPoints( bpoints );
-
-const bline = new THREE.Line( bgeometry, material );
-
-scene.add( bline );
-
-/* 
-Notation TOP :=
-  ({| left_pt := {| p_x := -4; p_y := 2|};
-      right_pt := {| p_x := 4; p_y := 2|}|}).
-
-*/
-
-const tpoints = [];
-tpoints.push( new THREE.Vector3( - 4, 2, 0 ) );
-tpoints.push( new THREE.Vector3(   4, 2, 0 ) );
-
-const tgeometry = new THREE.BufferGeometry().setFromPoints( tpoints );
-
-const tline = new THREE.Line( tgeometry, material );
-
-scene.add( tline );
-
-/* 
-Definition example_edge_list : seq edge :=
-  Bedge (Bpt (-3) 0) (Bpt (-2) 1) ::
-  Bedge (Bpt (-3) 0) (Bpt 0 (-3)) ::
-  Bedge (Bpt 0 (-3)) (Bpt 3 0) ::
-  Bedge (Bpt (-2) 1) (Bpt 0 1) ::
-  Bedge (Bpt 0 1) (Bpt 1 0) ::
-  Bedge (Bpt (-1) 0) (Bpt 0 (-1)) ::
-  Bedge (Bpt 0 (-1)) (Bpt 1 0) :: nil.
-*/
-
-const edge_list = [
-  {fx : -3, fy : 0, tx : -2, ty : 1},  
-  {fx : -3, fy : 0, tx :  0, ty : -3},
-  {fx :  0, fy : -3, tx : 3, ty : 0},
-  {fx :  -2, fy : 1, tx : 0, ty : 1},
-  {fx :  0, fy : 1, tx : 1, ty : 0},
-  {fx :  -1, fy : 0, tx : 0, ty : -1},
-  {fx :  0, fy : -1, tx : 1, ty : 0}
-];
-
-edge_list.forEach(add_edge);
-
-function add_edge(edge) {
-  let epoints = [];
-  epoints.push( new THREE.Vector3(edge.fx, edge.fy, 0 ) );
-  epoints.push( new THREE.Vector3(edge.tx, edge.ty, 0 ) );
-  let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-  let eline = new THREE.Line( egeometry, material );
-  scene.add( eline );
-}
-
-/* curve
-	 = straight {| p_x := -1.9; p_y := -3 # 2 |};
-              {| p_x := -19 # 20; p_y := -480 # 192 |} :: 
-      bezier  {| p_x := -19 # 20; p_y := -480 # 192 |};
-              {| p_x := 0; p_y := -168 # 48 |}
-              {| p_x := 3 # 2; p_y := -12672 # 4608 |}; ::
-      bezier  {| p_x := 3 # 2; p_y := -12672 # 4608 |};
-              {| p_x := 3; p_y := -96 # 48 |}
-              {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |} :: 
-      bezier  {| p_x := 0x3.4%xQ; p_y := -589824 # 393216 |}
-              {| p_x := 28 # 8; p_y := (-0x1.000)%xQ |}
-              {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}  ::
-      bezier  {| p_x := 0x3.4%xQ; p_y := 0 # 131072 |}
-              {| p_x := 3; p_y := 0x1.0%xQ |}
-              {| p_x := 4 # 2; p_y := 0 # 192 |} ::
-      bezier  {| p_x := 4 # 2; p_y := 0 # 192 |}
-              {| p_x := 1; p_y := -6 # 6 |}
-              {| p_x := 1 # 2; p_y := -36 # 24 |} ::
-      bezier  {| p_x := 1 # 2; p_y := -36 # 24 |}
-              {| p_x := 0; p_y := -4 # 2 |}
-              {| p_x := -1 # 2; p_y := -36 # 24 |}
-      bezier  {| p_x := -1 # 2; p_y := -36 # 24 |}
-              {| p_x := -1; p_y := -6 # 6 |}
-              {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |} ::
-      bezier  {| p_x := (-0x1.4)%xQ; p_y := -1080 # 1728 |}
-              {| p_x := -12 # 8; p_y := -36 # 144 |}
-              {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |} ::
-      bezier  {| p_x := (-0x1.4)%xQ; p_y := 144 # 1152 |}
-              {| p_x := -1; p_y := 2 # 4 |}
-              {| p_x := -1 # 2; p_y := 8 # 32 |} ::
-      bezier  {| p_x := -1 # 2; p_y := 8 # 32 |};
-               ({| p_x := 0; p_y := 0|}).
-              {| p_x := 1 # 6; p_y := 0 # 8 |} ::
-      straight {| p_x := 1 # 6; p_y := 0 # 8 |};
-               {| p_x := 1 # 3; p_y := 0 |};
-*/
-
-const curve_list = [
-  {b : false, fx : -1.9, fy : -(3/2), tx : -(19/20), ty : - (480 / 192)},  
-  {b : true, fx : -(19/20), fy : -(480/192), 
-             cx : 0, cy : -(168/48), tx : (3/2), ty : -(12672/4608)},
- {b : true, fx : (3/2), fy : -(12672/4608), 
-             cx : 3, cy : -(96/48), tx : (3 + 4/16), ty : -(589824/393216)},
- {b : true, fx : (3 + 4 /16), fy : -(589824/393216), 
-             cx : (28/8), cy : -(1), tx : (3 + 4/16), ty : 0},
- {b : true, fx : (3 + 4/16), fy : 0, 
-             cx : 3, cy : 1.0, tx : (4/2), ty : 0},
- {b : true, fx : (4/2), fy : 0, 
-             cx : 1, cy : -(6/6), tx : (1/2), ty : -(36/24)},
- {b : true, fx : (1/2), fy : -(36/24), 
-             cx : 0, cy : -(4/2), tx : -(1/2), ty : -(36/24)},
- {b : true, fx : -(1/2), fy : -(36/24), 
-             cx : -1, cy : -(6/6), tx : -(1 + 4 / 16), ty : -(1080/1728)},
- {b : true, fx : -(1 + 4 / 16), fy : -(1080/1728), 
-             cx : -(12/8), cy : -(36/144), tx : -(1 + 4/16), ty : (144/1152)},
- {b : true, fx : -(1 + 4 / 16), fy : (144/1152), 
-             cx : -1, cy : (2/4), tx : -(1/2), ty : (8/32)},
- {b : true, fx : -(1/2), fy : (8/32), 
-             cx : 0, cy : 0, tx : (1/6), ty : 0},
-  {b : false, fx : (1/6), fy : 0, tx : (1/3), ty : 0}  
-];
-
-curve_list.forEach(add_curve);
-
-function add_curve(curve) {
-  if (curve.b) {
-    let ccurve = new THREE.QuadraticBezierCurve3(
-                	new THREE.Vector3(curve.fx, curve.fy, 0 ),
-	                new THREE.Vector3(curve.cx, curve.cy, 0 ),
-	                new THREE.Vector3(curve.tx, curve.ty, 0 )
-                );
-    let cpoints = ccurve.getPoints( 50 );
-    let cgeometry = new THREE.BufferGeometry().setFromPoints( cpoints );
-    let cline = new THREE.Line( cgeometry, cmaterial );
-    scene.add( cline );
-  } else {
-    let epoints = [];
-    epoints.push( new THREE.Vector3(curve.fx, curve.fy, 0 ) );
-    epoints.push( new THREE.Vector3(curve.tx, curve.ty, 0 ) );
-    let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
-    let sline = new THREE.Line( egeometry, cmaterial );
-    scene.add( sline );
-  }
-}
-
-renderer.render( scene, camera );

From 803d46bd9e1b94a1b344ac94d2f93b6ea8b67215 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Thu, 25 Apr 2024 11:09:01 +0200
Subject: [PATCH 21/43] now the proof compiles again, also use euclidean
 distance

---
 theories/generic_trajectories.v | 79 +++++++++++++++++----------------
 theories/no_crossing.v          |  2 +
 theories/smooth_trajectories.v  | 14 +++++-
 3 files changed, 56 insertions(+), 39 deletions(-)

diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 99e34ab..28a29b6 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -81,7 +81,7 @@ Definition dummy_pt := ({| p_x := R1; p_y := R1|}).
 
 Definition dummy_edge := Bedge dummy_pt dummy_pt.
 
-Definition dummy_cell := 
+Definition dummy_cell :=
   {| left_pts := nil; right_pts := nil; low := dummy_edge; high := dummy_edge|}.
 
 Definition dummy_event :=
@@ -148,11 +148,11 @@ Definition valid_edge e p := (R_leb (p_x (left_pt e)) (p_x p)) &&
 (* TODO: check again the mathematical formula after replacing the infix     *)
 (* operations by prefix function calls. *)
 Definition vertical_intersection_point (p : pt) (e : edge) : option pt :=
-  if valid_edge e p then 
+  if valid_edge e p then
     Some(Bpt (p_x p) (R_add
        (R_mul (R_sub (p_x p) (p_x (left_pt e)))
       (R_div (R_sub (p_y (right_pt e)) (p_y (left_pt e)))
-    (R_sub (p_x (right_pt e)) (p_x (left_pt e))))) 
+    (R_sub (p_x (right_pt e)) (p_x (left_pt e)))))
      (p_y (left_pt e))))
     else None.
 
@@ -192,9 +192,9 @@ Notation "p <<< g" := (point_strictly_under_edge p g)
   (at level 70, no associativity).
 
 Definition edge_below (e1 : edge) (e2 : edge) : bool :=
-(point_under_edge (left_pt e1) e2 && 
+(point_under_edge (left_pt e1) e2 &&
  point_under_edge (right_pt e1) e2)
-|| (negb (point_strictly_under_edge (left_pt e2) e1) && 
+|| (negb (point_strictly_under_edge (left_pt e2) e1) &&
    negb (point_strictly_under_edge (right_pt e2) e1)).
 
 Definition contains_point (p : pt) (c : cell)  : bool :=
@@ -204,7 +204,7 @@ Definition close_cell (p : pt) (c : cell) :=
   match vertical_intersection_point p (low c),
         vertical_intersection_point p (high c) with
   | None, _ | _, None => c
-  | Some p1, Some p2 => 
+  | Some p1, Some p2 =>
     Bcell (left_pts c) (no_dup_seq (p1 :: p :: p2 :: nil)) (low c) (high c)
   end.
 
@@ -217,7 +217,7 @@ Definition pvert_y (p : pt) (e : edge) :=
   | None => R0
   end.
 
-Fixpoint opening_cells_aux (p : pt) (out : seq edge) (low_e high_e : edge) 
+Fixpoint opening_cells_aux (p : pt) (out : seq edge) (low_e high_e : edge)
   : seq cell * cell :=
   match out with
   | [::] =>
@@ -251,7 +251,7 @@ if open_cells is c :: q then
 else
   None.
 
-Fixpoint open_cells_decomposition_rec open_cells pt : 
+Fixpoint open_cells_decomposition_rec open_cells pt :
   seq cell * seq cell * cell * seq cell :=
 if open_cells is c :: q then
   if contains_point pt c then
@@ -339,7 +339,7 @@ Definition step (st : scan_state) (e : event) : scan_state :=
    let p := point e in
    let '(Bscan op1 lsto op2 cls cl lhigh lx) := st in
    if negb (same_x p lx) then
-     let '(first_cells, contact_cells, last_contact, last_cells, 
+     let '(first_cells, contact_cells, last_contact, last_cells,
            lower_edge, higher_edge) :=
        open_cells_decomposition (op1 ++ lsto :: op2) p in
      simple_step first_cells contact_cells last_cells last_contact
@@ -351,7 +351,7 @@ Definition step (st : scan_state) (e : event) : scan_state :=
      let first_cells := op1 ++ lsto :: fc' in
      simple_step first_cells contact_cells last_cells last_contact
        low_edge higher_edge cls cl e
-   else if p <<< lhigh then 
+   else if p <<< lhigh then
      let new_closed := update_closed_cell cl (point e) in
      let (new_opens, new_lopen) := update_open_cell lsto e in
      Bscan (op1 ++ new_opens) new_lopen op2 cls new_closed lhigh lx
@@ -440,12 +440,12 @@ Variable node_eqb : node -> node -> bool.
 Variable neighbors_of_node : node -> seq (node * R).
 Variable source target : node.
 
-Definition path := seq node.
+Definition gpath := seq node.
 Variable priority_queue : Type.
 Variable empty : priority_queue.
-Variable find : priority_queue -> node -> option (path * option R).
-Variable update : priority_queue -> node -> path -> option R -> priority_queue.
-Variable pop :  priority_queue -> option (node * path * option R * priority_queue).
+Variable gfind : priority_queue -> node -> option (gpath * option R).
+Variable update : priority_queue -> node -> gpath -> option R -> priority_queue.
+Variable pop :  priority_queue -> option (node * gpath * option R * priority_queue).
 
 Definition cmp_option (v v' : option R) :=
   if v is Some x then
@@ -459,8 +459,8 @@ Definition cmp_option (v v' : option R) :=
 Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
   (q : priority_queue) : priority_queue :=
   let neighbors := neighbors_of_node d in
-  foldr (fun '(d', dist') q => 
-           match find q d' with
+  foldr (fun '(d', dist') q =>
+           match gfind q d' with
            | None => q
            | Some (p', o_dist) =>
              let new_dist_to_d' := Some (R_add dist dist') in
@@ -475,7 +475,7 @@ Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
   |S fuel' =>
     match pop q with
     | Some (d, p, Some dist, q') =>
-      if node_eqb d target then Some p else 
+      if node_eqb d target then Some p else
         Dijkstra fuel' (Dijkstra_step d p dist q')
     | _ => None
     end
@@ -516,12 +516,12 @@ end.
 (* Vertical edges are collected from the left_pts and right_pts sequences. *)
 Definition cell_safe_exits_left (c : cell) : seq vert_edge :=
   let lx := p_x (head dummy_pt (left_pts c)) in
-  map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p))) 
+  map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p)))
    (seq_to_intervals (left_pts c)).
 
 Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   let lx := p_x (head dummy_pt (right_pts c)) in
-  map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p))) 
+  map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p)))
    (seq_to_intervals (rev (right_pts c))).
 
 Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
@@ -530,16 +530,16 @@ Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
 Definition cells_to_doors (s : list cell) :=
   let indexed_s := index_seq s in
   let vert_edges_and_right_cell :=
-    flatten (map (fun '(i, c) => 
+    flatten (map (fun '(i, c) =>
                    (map (fun v => (v, i))) (cell_safe_exits_left c))
       indexed_s) in
   let vert_edges_and_both_cells :=
-    flatten (map (fun '(v, i) => 
+    flatten (map (fun '(v, i) =>
           (map (fun '(i', c') => (v, i, i'))
                (filter (fun '(i', c') =>
                    existsb (vert_edge_eqb v) (cell_safe_exits_right c'))
                    indexed_s)))
-           vert_edges_and_right_cell) in 
+           vert_edges_and_right_cell) in
       vert_edges_and_both_cells.
 
 Definition on_vert_edge (p : pt) (v : vert_edge) : bool :=
@@ -592,7 +592,7 @@ Definition add_extremity_reference_point
 
 Definition doors_and_extremities (indexed_cells : seq (nat * cell))
   (doors : seq door) (s t : pt) : seq door * nat * nat :=
-  let '(d_s, i_s) := 
+  let '(d_s, i_s) :=
      add_extremity_reference_point indexed_cells s doors in
   let '(d_t, i_t) :=
      add_extremity_reference_point indexed_cells t d_s in
@@ -629,16 +629,16 @@ Definition cells_to_doors_graph (cells : seq cell) (s t : pt) :=
 
 Definition node := nat.
 
-Definition empty := @nil (node * path node * option R).
+Definition empty := @nil (node * gpath node * option R).
 
-Notation priority_queue := (list (node * path node * option R)).
+Notation priority_queue := (list (node * gpath node * option R)).
 
 Definition node_eqb := Nat.eqb.
 
-Fixpoint find (q : priority_queue) n :=
+Fixpoint gfind (q : priority_queue) n :=
   match q with
   | nil => None
-  | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else find tl n
+  | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else gfind tl n
   end.
 
 Fixpoint remove (q : priority_queue) n :=
@@ -665,7 +665,7 @@ Definition update q n p d :=
   insert (remove q n) n p d.
 
 Definition pop  (q : priority_queue) :
-   option (node * path node * option R * priority_queue) :=
+   option (node * gpath node * option R * priority_queue) :=
   match q with
   | nil => None
   | v :: tl => Some (v, tl)
@@ -675,7 +675,7 @@ Definition c_shortest_path cells s t :=
   let '(adj, i_s, i_t) := cells_to_doors_graph cells s t in
   (adj, shortest_path node node_eqb (seq.nth [::] adj.2) i_s
     i_t _ empty
-   find update pop (iota 0 (size adj.2)), i_s, i_t).
+   gfind update pop (iota 0 (size adj.2)), i_s, i_t).
 
 Definition midpoint (p1 p2 : pt) : pt :=
  {| p_x := R_div (R_add (p_x p1) (p_x p2)) R2;
@@ -725,7 +725,7 @@ Fixpoint a_shortest_path (cells : seq cell)
     let a_p' := door_to_annotated_point s t d' p'i in
     if R_eqb (p_x (apt_val p)) (p_x (apt_val a_p')) then
        let ci := common_index (cell_indices p) (cell_indices a_p') in
-       let p_extra : annotated_point := 
+       let p_extra : annotated_point :=
          safe_intermediate_point_in_cell (apt_val p) (apt_val a_p')
            (seq.nth dummy_cell cells ci) ci in
        p :: p_extra :: a_shortest_path cells doors s t a_p' tlpath
@@ -749,14 +749,17 @@ Definition source_to_target
           seq (annotated_point * annotated_point)) :=
   let '(doors, opath, i_s, i_t) :=
        c_shortest_path cells source target in
-  let last_point := 
-     door_to_annotated_point source target
-         (seq.nth dummy_door doors.1 i_t) i_t in
-  if opath is Some path then
-    match a_shortest_path cells doors source target
-              last_point path with
-    | nil => None
-    | a :: tl => Some(doors.1, path_reverse (path_to_segments a tl))
+  if Nat.eqb i_s i_t then
+    Some (doors.1, [:: (Apt source None [::], Apt target None [::])])
+  else
+    let last_point :=
+       door_to_annotated_point source target
+           (seq.nth dummy_door doors.1 i_t) i_t in
+    if opath is Some path then
+      match a_shortest_path cells doors source target
+                last_point path with
+      | nil => None
+      | a :: tl => Some(doors.1, path_reverse (path_to_segments a tl))
     end
   else
     None.
diff --git a/theories/no_crossing.v b/theories/no_crossing.v
index 2be8261..5e71a20 100644
--- a/theories/no_crossing.v
+++ b/theories/no_crossing.v
@@ -256,8 +256,10 @@ Lemma cnt14 :
 Proof. easy. Qed.
 
 Import String.
+(*
 Compute example_test (List.concat (List.map outgoing evs14))
              (Bpt 1.2 (-0.8)) (Bpt (-1) (0.4)) nil.
+*)
 Compute (concat "
 " (postscript_header ++
    display_edge 300 400 70 example_bottom ::
diff --git a/theories/smooth_trajectories.v b/theories/smooth_trajectories.v
index c680012..155ef37 100644
--- a/theories/smooth_trajectories.v
+++ b/theories/smooth_trajectories.v
@@ -31,7 +31,19 @@ Definition scan :=
 Definition manhattan_distance (p1x p1y p2x p2y : R) :=
   Qabs (p2x - p1x) + Qabs (p2y - p1y).
 
-Definition pt_distance := manhattan_distance.
+Definition approx_sqrt (x : Q) :=
+  let n := Qnum x in
+  let d := Qden x in
+  let safe_n := (1024 * n)%Z in
+  let safe_d := (1024 * d)%positive in
+  let n' := Z.sqrt safe_n in
+  let d' := Pos.sqrt safe_d in
+  Qred (Qmake n' d').
+
+Definition euclidean_distance  (p1x p1y p2x p2y : R) :=
+  approx_sqrt ((p2x - p1x) ^ 2 + (p2y - p1y) ^ 2).
+
+Definition pt_distance := euclidean_distance.
 
 Definition Qsmooth_point_to_point :=
  smooth_point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv

From 6eaa71c53303914be4bdf793f1734bc54c48c361 Mon Sep 17 00:00:00 2001
From: thery <Laurent.Thery@inria.fr>
Date: Fri, 26 Apr 2024 03:13:04 +0200
Subject: [PATCH 22/43] load and save button

---
 www/grid.html |  5 +++
 www/grid.js   | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+)

diff --git a/www/grid.html b/www/grid.html
index 118df43..8452fd9 100755
--- a/www/grid.html
+++ b/www/grid.html
@@ -28,6 +28,11 @@
 <label for="Position">Starting and ending positions</label> 
 <input type="checkbox" id="cell" name="Show Cells">
 <label> Show Cells </label>
+<p>
+<button id="loadButton">Load</button>
+<button id="saveButton">Save</button>
+</p>
+
 <p>
   To add an obstacle, click to a first end-point (blue square)
   then click to the second end-point
diff --git a/www/grid.js b/www/grid.js
index 7281805..27a200f 100644
--- a/www/grid.js
+++ b/www/grid.js
@@ -444,3 +444,92 @@ function onDocumentMouseDown( event ) {
         renderer.render( scene, camera );
     }
 }
+
+
+document.getElementById('loadButton').addEventListener('click', function() { 
+  let input = document.createElement('input');
+  input.type = 'file';
+  input.accept = 'text/*'
+  input.onchange = _ => {
+    // you can use this method to get file and perform respective operations
+            let files =   Array.from(input.files);
+            if (files.length < 1) {
+                return;
+            }
+            let file = files[0];
+            var reader = new FileReader();
+            reader.onload = function(progressEvent) {
+                fromValid = false;         
+                toValid = false;         
+                fromCube.position.y = -0.2;
+                toCube.position.y = -0.2;
+                for (const obstacle of obstacles) {
+                    scene.remove(obstacle.line);
+                }
+                obstacles = [];
+                renderer.render( scene, camera );
+                // Entire file
+                const text = this.result;
+                // By lines
+                var lines = text.split('\n');
+                var i = 0;
+                if (lines[i].indexOf('Obstacles') != -1) {
+                    i++;
+                    while ((i < lines.length) && (lines[i].length != 0) && 
+                           (lines[i].indexOf("Positions") == -1)) {
+                        var fX = parseFloat(lines[i]);
+                        var fZ = parseFloat(lines[i+1]);
+                        var tX = parseFloat(lines[i+2]);
+                        var tZ = parseFloat(lines[i+3]);
+                        addObstacle(fX, fZ, tX, tZ);
+                        i += 4;
+                    }
+                }
+                if (lines[i].indexOf("Positions") != -1) {
+                    document.getElementById('positions').checked = true;
+                    var fX = parseFloat(lines[i+1]);
+                    var fZ = parseFloat(lines[i+2]);
+                    var tX = parseFloat(lines[i+3]);
+                    var tZ = parseFloat(lines[i+4]);
+                    i += 5;
+                    fromValid = true;         
+                    toValid = true;         
+                    fromCube.position.z = fZ;
+                    fromCube.position.y = fromY;
+                    fromCube.position.x = fX;
+                    toCube.position.z = tZ;
+                    toCube.position.y = toY;
+                    toCube.position.x = tX;
+                    renderer.render( scene, camera );
+                    positions = {fX : fX, fZ : fZ, tX : tX, tZ : tZ }
+                    cleanCurve();
+                    getCurve();
+                    renderer.render( scene, camera );
+                }
+            };
+            reader.readAsText(file);
+        };
+   input.click();
+}); 
+
+document.getElementById('saveButton').addEventListener('click', function() { 
+   const link = document.createElement("a");
+   let val = "";
+   if (obstacles.length != 0) {
+        val += "Obstacles\n";
+                for (const obstacle of obstacles) {
+                    val += obstacle.fX + "\n" + obstacle.fZ + "\n" 
+                            + obstacle.tX + "\n"  + obstacle.tZ + "\n";  
+                    } 
+        if (positions != null) {
+                val += "Positions\n";
+                val += positions.fX + "\n" + positions.fZ + "\n";
+                val += positions.tX + "\n" + positions.tZ + "\n";
+        }
+   }
+   const file = new Blob([val], { type: 'text/plain' });
+   link.href = URL.createObjectURL(file);
+   link.download = "sample.txt";
+   link.click();
+   URL.revokeObjectURL(link.href);
+}); 

From 651a4c81e1cea3d8b487bbe2c90c0e0771034d4f Mon Sep 17 00:00:00 2001
From: thery <Laurent.Thery@inria.fr>
Date: Fri, 26 Apr 2024 03:34:42 +0200
Subject: [PATCH 23/43] fix modality in graph display

---
 www/grid.js | 1 +
 1 file changed, 1 insertion(+)

diff --git a/www/grid.js b/www/grid.js
index 27a200f..0b353fe 100644
--- a/www/grid.js
+++ b/www/grid.js
@@ -487,6 +487,7 @@ document.getElementById('loadButton').addEventListener('click', function() {
                 }
                 if (lines[i].indexOf("Positions") != -1) {
                     document.getElementById('positions').checked = true;
+                    setModality();
                     var fX = parseFloat(lines[i+1]);
                     var fZ = parseFloat(lines[i+2]);
                     var tX = parseFloat(lines[i+3]);

From cd210d151a21b9f5dee65408475a31aade6ed65e Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Fri, 26 Apr 2024 04:02:54 +0200
Subject: [PATCH 24/43] changes of notations, and underE and strictE work on
 the concept definied in points_and_edge instead of generic_trajectories

---
 theories/points_and_edges.v | 523 ++++++++++++++++++------------------
 1 file changed, 263 insertions(+), 260 deletions(-)

diff --git a/theories/points_and_edges.v b/theories/points_and_edges.v
index a685524..86f3e1b 100644
--- a/theories/points_and_edges.v
+++ b/theories/points_and_edges.v
@@ -18,9 +18,11 @@ Section working_context.
 Variable (R : realFieldType).
 
 Definition pt := pt R.
-Notation Bpt := (Bpt R).
-Notation p_x := (generic_trajectories.p_x R).
-Notation p_y := (generic_trajectories.p_y R).
+Notation Bpt := (Bpt _).
+Notation "p .x" := (generic_trajectories.p_x _ p)
+    (at level 2, left associativity, format "p .x").
+Notation "p .y" := (generic_trajectories.p_y _ p)
+    (at level 2, left associativity, format "p .y").
 
 Lemma pt_eqP : Equality.axiom (pt_eqb R eq_op).
 Proof.
@@ -36,18 +38,18 @@ Qed.
 HB.instance Definition _ := hasDecEq.Build _ pt_eqP.
 
 Lemma pt_eqE (p1 p2 : pt) :
-   (p1 == p2) = (p_x p1 == p_x p2) && (p_y p1 == p_y p2).
+   (p1 == p2) = (p1.x == p2.x) && (p1.y == p2.y).
 Proof. by move: p1 p2 => [? ?][? ?]. Qed.
 
 Record edge := Bedge {left_pt : pt; right_pt : pt;
-    _ : p_x left_pt < p_x right_pt}.
+    _ : left_pt.x < right_pt.x}.
 
 Definition edge_eqb (e1 e2 : edge) : bool :=
    let: Bedge a1 b1 p1 := e1 in
    let: Bedge a2 b2 p2 := e2 in
    (a1 == a2) && (b1 == b2).
 
-Lemma edge_cond (e : edge) : p_x (left_pt e) < p_x (right_pt e).
+Lemma edge_cond (e : edge) : (left_pt e).x < (right_pt e).x.
 Proof.  by move: e => [l r c]. Qed.
 
 Lemma edge_eqP : Equality.axiom edge_eqb.
@@ -64,8 +66,8 @@ Qed.
 
 HB.instance Definition _ := hasDecEq.Build _ edge_eqP.
 
-Definition area3 :=
-  area3 R +%R (fun x y => x - y) *%R.
+Notation area3 :=
+  (area3 R +%R (fun x y => x - y) *%R).
 
 (* returns true if p is under e *)
 Definition point_under_edge :=
@@ -80,18 +82,20 @@ Lemma R_ltb_lt  x y : R_ltb R eq_op le x y = (x < y).
 Proof. by rewrite /R_ltb -lt_neqAle. Qed.
 
 Lemma strictE p e :
-  generic_trajectories.point_strictly_under_edge R eq_op le +%R
-    (fun x y => x - y) *%R 1 edge left_pt right_pt p e =
+  point_strictly_under_edge (*R eq_op le +%R
+    (fun x y => x - y) *%R 1 edge left_pt right_pt *) p e =
   (area3 p (left_pt e) (right_pt e) < 0).
 Proof.
-by rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt subrr.
+by rewrite /point_strictly_under_edge/generic_trajectories.point_strictly_under_edge R_ltb_lt subrr.
 Qed.
 
 Lemma underE p e :
-  generic_trajectories.point_under_edge R le +%R
-    (fun x y => x - y) *%R 1 edge left_pt right_pt p e =
+  point_under_edge (* R le +%R
+    (fun x y => x - y) *%R 1 edge left_pt right_pt *) p e =
   (area3 p (left_pt e) (right_pt e) <= 0).
-Proof. by rewrite /generic_trajectories.point_under_edge subrr. Qed.
+Proof.
+by rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
+Qed.
 
 Notation "p '<<=' e" := (point_under_edge p e)( at level 70, no associativity).
 Notation "p '<<<' e" := (point_strictly_under_edge p e)(at level 70, no associativity).
@@ -438,7 +442,7 @@ Qed.
 End ring_sandbox.
 
 Lemma area3E a b c : area3 a b c =
-   pue_f (p_x a) (p_y a) (p_x b) (p_y b) (p_x c) (p_y c).
+   pue_f a.x (a.y) b.x (b.y) c.x (c.y).
 Proof. by case: a b c=> [a_x a_y] [b_x b_y] [c_x c_y]. Qed.
 
 Lemma area3_opposite a b d:  area3 d a b = - area3 b a d.
@@ -453,8 +457,8 @@ Proof.
   apply :pue_f_c.
 Qed.
 
-Lemma area3_vert a b c : (p_x b = p_x c) ->
-area3 a b c == (p_x b - p_x a) * (p_y c - p_y b).
+Lemma area3_vert a b c : (b.x = c.x) ->
+area3 a b c == (b.x - a.x) * (c.y - b.y).
 Proof.
 move: a b c => [ax ay] [b_x b_y] [cx cy]/= <-.
 apply : pue_f_vert.
@@ -479,8 +483,8 @@ Qed.
 
 Lemma area3_on_edge a b c d m :
 area3 m a b == 0 ->
-(p_x b - p_x a) * area3 m c d ==
-(p_x m - p_x a) * area3 b c d + (p_x b - p_x m) * area3 a c d.
+(b.x - a.x) * area3 m c d ==
+(m.x - a.x) * area3 b c d + (b.x - m.x) * area3 a c d.
 Proof.
 move : a b c d m => [ax ay] [b_x b_y] [cx cy] [dx dy] [mx my]/=.
 apply pue_f_on_edge.
@@ -488,7 +492,7 @@ Qed.
 
 Lemma area3_on_edge_y a b m :
 area3 m a b == 0 ->
-(p_x b - p_x a) * p_y m = p_x m * (p_y b - p_y a) - (p_x a * p_y b - p_x b * p_y a).
+(b.x - a.x) * m.y = m.x * (b.y - a.y) - (a.x * b.y - b.x * a.y).
 Proof.
 move : a b m => [ax ay] [b_x b_y]  [mx my]/=.
 apply pue_f_on_edge_y.
@@ -496,50 +500,50 @@ Qed.
 
 Lemma area3_triangle_on_edge a b p p' :
 area3 p' a b == 0 ->
-(p_x b - p_x a) * area3 p' a p ==
-(p_x p' - p_x a) * area3 b a p.
+(b.x - a.x) * area3 p' a p ==
+(p'.x - a.x) * area3 b a p.
 Proof.
 move : a b p p' => [ax ay] [b_x b_y] [px py] [p'x p'y] /=.
 apply pue_f_triangle_on_edge.
 Qed.
 
 Definition subpoint (p : pt) :=
-  Bpt (p_x p) (p_y p - 1).
+  Bpt (p.x) (p.y - 1).
 
 Lemma edge_and_left_vertical (p q a : pt) :
-  p_x p < p_x a -> p_x p = p_x q ->
-  (0 < area3 p q a) = (p_y q < p_y p).
+  p.x < a.x -> p.x = q.x ->
+  (0 < area3 p q a) = (q.y < p.y).
 Proof.
 case: p=> [px py]; case: a=> [ax ay]; case: q=> [qx qy] /=.
 by move=> c1 c2; apply edge_and_left_vertical_f.
 Qed.
 
 Lemma edge_and_left_vertical_eq (p q a : pt) :
-  p_x p < p_x a -> p_x p = p_x q ->
+  p.x < a.x -> p.x = q.x ->
   (area3 p q a == 0) = (p == q).
 Proof.
 move=> edge_cond vert_cond.
 apply/idP/idP; last first.
   by move/eqP ->; rewrite (area3_two_points q a).1.
-move=> abs; suff : p_y p = p_y q.
+move=> abs; suff : p.y = q.y.
   by move: vert_cond {edge_cond abs}; case: p=> [? ?]; case q=> [? ?]/= <- <-.
-apply: le_anti. rewrite (leNgt (p_y p) (p_y q)).
+apply: le_anti. rewrite (leNgt (p.y) (q.y)).
 rewrite -(edge_and_left_vertical edge_cond vert_cond) (eqP abs).
-have ec' : p_x q < p_x a by rewrite -vert_cond.
+have ec' : q.x < a.x by rewrite -vert_cond.
 rewrite leNgt -(edge_and_left_vertical ec' (esym vert_cond)).
 by rewrite area3_opposite -area3_cycle (eqP abs) oppr0 ltxx.
 Qed.
 
 Lemma edge_and_right_vertical (p q a : pt) :
-  p_x a < p_x p -> p_x p = p_x q ->
-  (0 < area3 p q a) = (p_y p < p_y q).
+  a.x < p.x -> p.x = q.x ->
+  (0 < area3 p q a) = (p.y < q.y).
 Proof.
 case: p=> [px py]; case: a=> [ax ay]; case: q=> [qx qy] /=.
 by move=> c1 c2; apply: edge_and_right_vertical_f.
 Qed.
 
 Lemma point_sub_right (p a : pt) :
-  (p_x p < p_x a) -> 0 < area3 p (subpoint p) a.
+  (p.x < a.x) -> 0 < area3 p (subpoint p) a.
 Proof.
 move=> edge_cond.
 rewrite edge_and_left_vertical //; rewrite /subpoint /= lterBDr cprD.
@@ -596,7 +600,7 @@ Definition below_alt (e1 : edge) (e2 : edge) :=
 Lemma edge_below_refl e : e <| e.
 Proof.
 apply/orP; left.
-rewrite /point_under_edge 2!underE.
+rewrite 2!underE.
 rewrite (eqP (proj1 (area3_two_points _ _))).
 by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
 Qed.
@@ -672,11 +676,11 @@ have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
 rewrite /point_strictly_under_edge.
 rewrite /generic_trajectories.point_strictly_under_edge subrr.
 rewrite !R_ltb_lt -!leNgt => llrllh llrllrh.
-have diffa : (p_x lr - p_x a) <= 0.
+have diffa : (lr.x - a.x) <= 0.
   by rewrite subr_cp0.
-have diffb : (p_x hr - p_x a) >= 0.
+have diffb : (hr.x - a.x) >= 0.
   by rewrite subr_cp0.
-have difflh : (p_x lr - p_x hr) < 0.
+have difflh : (lr.x - hr.x) < 0.
   by rewrite subr_cp0.
 rewrite -(ler_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_le0 (eqP pf).
 by rewrite addr_ge0 // mulr_ge0 // subr_ge0.
@@ -692,11 +696,11 @@ move : high_e => [lr hr inH] /=.
 rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
 rewrite /point_under_edge -!ltNge !subrr => llrllh llrllrh.
-have diffa : (p_x lr - p_x a) <= 0.
+have diffa : (lr.x - a.x) <= 0.
   by rewrite subr_cp0.
-have diffb : (p_x hr - p_x a) >= 0.
+have diffb : (hr.x - a.x) >= 0.
   by rewrite subr_cp0.
-have difflh : (p_x lr - p_x hr) < 0.
+have difflh : (lr.x - hr.x) < 0.
   by rewrite subr_cp0.
 rewrite -(ltr_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_lt0 (eqP pf).
 have addr_le_gt0 (x y : R) : 0 <= x -> 0 < y -> 0 < x + y.
@@ -720,11 +724,11 @@ move : low_e => [lr hr inH] /=.
 rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
 rewrite /point_under_edge /generic_trajectories.point_under_edge !subrr=> llrllh llrllrh.
-have diffa : (p_x lr - p_x a) <= 0.
+have diffa : (lr.x - a.x) <= 0.
   by rewrite subr_cp0.
-have diffb : (p_x hr - p_x a) >= 0.
+have diffb : (hr.x - a.x) >= 0.
   by rewrite subr_cp0.
-have difflh : (p_x lr - p_x hr) < 0.
+have difflh : (lr.x - hr.x) < 0.
   by rewrite subr_cp0.
 rewrite -(ler_nM2r difflh 0 _) mul0r mulrC -opprB mulNr (eqP pf) opprD.
 by rewrite addr_ge0 // -mulNr mulr_le0 // oppr_le0 subr_cp0.
@@ -742,11 +746,11 @@ have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
 rewrite /point_strictly_under_edge.
 rewrite/generic_trajectories.point_strictly_under_edge.
 rewrite !R_ltb_lt !subrr=> llrllh llrllrh.
-have diffa : (p_x lr - p_x a) <= 0.
+have diffa : (lr.x - a.x) <= 0.
   by rewrite subr_cp0.
-have diffb : (p_x hr - p_x a) >= 0.
+have diffb : (hr.x - a.x) >= 0.
   by rewrite subr_cp0.
-have difflh : (p_x lr - p_x hr) < 0.
+have difflh : (lr.x - hr.x) < 0.
   by rewrite subr_cp0.
 rewrite -(ltr_nM2l difflh 0) mulr0 -opprB mulNr oppr_gt0 (eqP pf).
 have addr_le_lt0 (x y : R) : x <= 0 -> y < 0 -> x + y < 0.
@@ -763,16 +767,16 @@ Qed.
 Lemma not_strictly_above' low_e high_e p':
 ~~ (left_pt (high_e) <<< low_e) ->
 ~~ (right_pt (high_e) <<< low_e) ->
-p' ===  high_e ->  p_x (right_pt (low_e)) = p_x p'  ->
+p' ===  high_e ->  (right_pt (low_e)).x = p'.x  ->
 right_pt (low_e) <<= high_e .
 Proof.
 move : low_e => [ll lr inL] /=.
 move => pablh pabrh poep' eqxp'p.
 have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inL)) eqxp'p .
 have := (point_on_edge_above poep' pablh pabrh ).
-rewrite /point_strictly_under_edge strictE.
-rewrite -area3_cycle -leNgt puefcpp' /point_under_edge underE.
-have inle: (p_x lr - p_x ll) >0.
+rewrite strictE.
+rewrite -area3_cycle -leNgt puefcpp' underE.
+have inle: (lr.x - ll.x) >0.
   by rewrite subr_cp0.
 rewrite (pmulr_rge0 _ inle) => inp'lr.
 have :=  (ax4_three_triangles lr  (left_pt high_e) (right_pt high_e) p') => /eqP <-.
@@ -783,14 +787,14 @@ have := (area3_vert (right_pt high_e) eqxp'p  ).
 rewrite -area3_cycle eqxp'p => /eqP ->.
 move : valp'.
 rewrite /valid_edge => /andP [] xlhp' xrhp'.
-have xrhp'0: p_x p' - p_x (right_pt high_e) <=0.
+have xrhp'0: p'.x - (right_pt high_e).x <=0.
   by rewrite subr_cp0.
 rewrite add0r.
 rewrite -oppr_ge0 opprD /= addr_ge0//.
   by rewrite -mulNr mulr_ge0 // oppr_ge0.
 have := (area3_vert (left_pt high_e) eqxp'p  ).
 rewrite -area3_opposite area3_cycle eqxp'p => /eqP ->.
-have xlhp'0: p_x p' - p_x (left_pt high_e) >= 0.
+have xlhp'0: p'.x - (left_pt high_e).x >= 0.
   by rewrite subr_cp0.
 by rewrite  mulr_ge0.
 Qed.
@@ -864,7 +868,7 @@ Qed.
 
 Lemma intersection_on_edge e p p' :
 vertical_intersection_point p e = Some (p') ->
-p'=== e /\ p_x p = p_x p'.
+p'=== e /\ p.x = p'.x.
 Proof.
 have := vertical_correct p e.
 case vert : (vertical_intersection_point p e)=> [vp |//=].
@@ -882,17 +886,17 @@ Lemma not_strictly_under' low_e high_e p' :
 (right_pt (low_e))<<= (high_e) ->
 (* This is an alternative way to say
   valid_edge low_e (right_pt high_e) *)
-p' === low_e ->  p_x (right_pt (high_e)) = p_x p'  ->
+p' === low_e ->  (right_pt (high_e)).x = p'.x  ->
 ~~ (right_pt (high_e) <<< low_e).
 Proof.
 move : high_e => [hl hr inH] /=.
 move => pablh pabrh poep' eqxp'p.
 have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inH)) eqxp'p .
 have := (point_on_edge_under poep' pablh pabrh ).
-rewrite /point_under_edge/point_strictly_under_edge underE strictE.
+rewrite underE strictE.
 rewrite -area3_cycle.
 rewrite -leNgt puefcpp'.
-have inle: (p_x hr - p_x hl) >0.
+have inle: (hr.x - hl.x) >0.
   by rewrite subr_cp0.
 rewrite (pmulr_rle0 _ inle )  => inp'hr.
 have :=  (ax4_three_triangles hr  (left_pt low_e) (right_pt low_e) p') => /eqP <-.
@@ -903,7 +907,7 @@ have := (area3_vert (right_pt low_e) eqxp'p  ).
 rewrite -area3_cycle eqxp'p => /eqP ->.
 move : valp'.
 rewrite /valid_edge => /andP [] xlhp' xrhp'.
-have xrhp'0: p_x p' - p_x (right_pt low_e) <=0.
+have xrhp'0: p'.x - (right_pt low_e).x <=0.
   by rewrite subr_cp0.
 rewrite add0r addr_ge0//.
   by rewrite mulr_le0.
@@ -913,8 +917,8 @@ by rewrite -mulNr mulr_le0 // oppr_le0 subr_cp0.
 Qed.
 
 Lemma pue_right_edge e p :
-p_x (right_pt e) == p_x p ->
-(p <<= e) = ((p_y p - p_y (right_pt e)) <= 0).
+(right_pt e).x == p.x ->
+(p <<= e) = ((p.y - (right_pt e).y) <= 0).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
 rewrite /point_under_edge/generic_trajectories.point_under_edge /=.
@@ -927,8 +931,8 @@ by rewrite subrr (pmulr_rle0 _  inE) .
 Qed.
 
 Lemma psue_right_edge e p :
-p_x (right_pt e) == p_x p ->
-(p <<< e) = ((p_y p - p_y (right_pt e)) < 0).
+(right_pt e).x == p.x ->
+(p <<< e) = ((p.y - (right_pt e).y) < 0).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= cnd] [px py]  /=.
 rewrite /point_strictly_under_edge/generic_trajectories.point_strictly_under_edge /=.
@@ -942,8 +946,8 @@ by rewrite subrr (pmulr_rlt0 _  cnd) .
 Qed.
 
 Lemma pue_left_edge e p :
-p_x (left_pt e) == p_x p ->
-(p <<= e) = (0 <= (p_y (left_pt e) - p_y p )).
+(left_pt e).x == p.x ->
+(p <<= e) = (0 <= ((left_pt e).y - p.y )).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
 rewrite /point_under_edge.
@@ -957,8 +961,8 @@ by rewrite subrr (nmulr_rle0 _  inE).
 Qed.
 
 Lemma psue_left_edge e p :
-p_x (left_pt e) == p_x p ->
-(p <<< e) = (0 < p_y (left_pt e) - p_y p).
+(left_pt e).x == p.x ->
+(p <<< e) = (0 < (left_pt e).y - p.y).
 Proof.
 move: e p => [[ax ay][bx b_y] /= cnd] [px py] /=.
 move=> /eqP <- /=.
@@ -999,11 +1003,11 @@ Qed.
 
 Lemma on_edge_same_point e p p':
 p === e -> p' === e ->
-(p_x p == p_x p') -> (p_y p == p_y p').
+(p.x == p'.x) -> (p.y == p'.y).
 Proof.
 move : e => [l r ec].
 rewrite /point_on_edge /= => /andP [] p0 _ /andP[] p'0 _.
-have dif : p_x l != p_x r.
+have dif : l.x != r.x.
   by apply/eqP=> abs; move: ec; rewrite abs ltxx.
 move: l r p0 p'0 dif {ec}=> [a_x a_y][b_x b_y] p0 p'0 dif.
 move: p p' p0 p'0 => [x y] [x' y'] puep0 puep'0.
@@ -1011,14 +1015,14 @@ rewrite /=; apply: (pue_f_on_edge_same_point dif puep0 puep'0).
 Qed.
 
 Lemma strict_under_edge_lower_y r r' e :
-  p_x r = p_x r' -> r' === e -> (r <<< e) = (p_y r < p_y r').
+  r.x = r'.x -> r' === e -> (r <<< e) = (r.y < r'.y).
 Proof.
 move=> rr' rone.
 have valre : valid_edge e r.
   by case/andP: rone; rewrite /valid_edge/generic_trajectories.valid_edge rr'.
 move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
   have req : r' = left_pt e.
-    have rltr : p_x r' < p_x (right_pt e) by rewrite -rr' -atl edge_cond.
+    have rltr : r'.x < (right_pt e).x by rewrite -rr' -atl edge_cond.
     have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
     by move/andP: rone => [] -> _ /eqP.
   by move/eqP/psue_left_edge: atl; rewrite subr_gt0 -req.
@@ -1033,8 +1037,8 @@ have rue' : (r <<< e) = (area3 r (left_pt e) r' < 0).
   rewrite signcond pmulr_rlt0; last by rewrite subr_gt0 -rr'.
     rewrite /point_strictly_under_edge.
     by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
-have inr' : p_x (left_pt e) < p_x r' by rewrite -rr'.
-have /psue_right_edge : p_x (right_pt (Bedge inr')) == p_x r.
+have inr' : (left_pt e).x < r'.x by rewrite -rr'.
+have /psue_right_edge : (right_pt (Bedge inr')).x == r.x.
   by rewrite /= rr' eqxx.
 rewrite rue' subr_lt0.
 rewrite /point_strictly_under_edge.
@@ -1072,7 +1076,7 @@ by rewrite valep andbT lt_neqAle.
 Qed.
 
 Lemma under_edge_strict_lower_y (r r' : pt) e :
-  p_x r = p_x r' -> r != r' -> r <<= e -> r' === e -> p_y r < p_y r'.
+  r.x = r'.x -> r != r' -> r <<= e -> r' === e -> r.y < r'.y.
 Proof.
 move=> xs nq under on'.
 have  vr : valid_edge e r.
@@ -1083,7 +1087,7 @@ by rewrite (strict_under_edge_lower_y xs).
 Qed.
 
 Lemma above_edge_strict_higher_y (r r' : pt)  e :
-  p_x r = p_x r' -> r != r' -> r >>= e -> r' === e -> p_y r' < p_y r.
+  r.x = r'.x -> r != r' -> r >>= e -> r' === e -> r'.y < r.y.
 Proof.
 move=> xs nq above on'.
 have  vr : valid_edge e r.
@@ -1094,14 +1098,14 @@ by case/negP: nq; rewrite pt_eqE xs ys !eqxx.
 Qed.
 
 Lemma under_edge_lower_y r r' e :
-  p_x r = p_x r' -> r' === e -> (r <<= e) = (p_y r <= p_y r').
+  r.x = r'.x -> r' === e -> (r <<= e) = (r.y <= r'.y).
 Proof.
 move=> rr' rone.
 have valre : valid_edge e r.
   by case/andP: rone; rewrite /valid_edge/generic_trajectories.valid_edge rr'.
 move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
   have req : r' = left_pt e.
-    have rltr : p_x r' < p_x (right_pt e) by rewrite -rr' -atl edge_cond.
+    have rltr : r'.x < (right_pt e).x by rewrite -rr' -atl edge_cond.
     have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
     by move/andP: rone => [] -> _ /eqP.
   by move/eqP/pue_left_edge: atl; rewrite subr_ge0 -req.
@@ -1115,28 +1119,28 @@ have rue' : (r <<= e) = (area3 r (left_pt e) r' <= 0).
   move: (edge_cond e); rewrite -subr_gt0 => /pmulr_rle0 <-.
   rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
   by rewrite signcond pmulr_rle0; last rewrite subr_gt0 -rr'.
-have inr' : p_x (left_pt e) < p_x r' by rewrite -rr'.
+have inr' : (left_pt e).x < r'.x by rewrite -rr'.
 rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
-have /pue_right_edge : p_x (right_pt (Bedge inr')) == p_x r.
+have /pue_right_edge : (right_pt (Bedge inr')).x == r.x.
   by rewrite /= rr' eqxx.
 move: rue'.
 rewrite /point_under_edge/generic_trajectories.point_under_edge subrr=> rue'.
 by rewrite rue' subr_le0.
 Qed.
 
-Lemma aligned_trans a a' b p : p_x a != p_x b ->
+Lemma aligned_trans a a' b p : a.x != b.x ->
   area3 a' a b == 0 ->
   area3 p a b == 0 -> area3 p a' b == 0.
 Proof.
 rewrite -area3_cycle.
 move=> bna /[dup]/area3_triangle_on_edge proc a'ab pab.
-have/mulfI/inj_eq <-  : p_x a - p_x b != 0 by rewrite subr_eq0.
+have/mulfI/inj_eq <-  : a.x - b.x != 0 by rewrite subr_eq0.
 rewrite -area3_cycle -(eqP (proc _)).
 by rewrite area3_cycle (eqP pab) !mulr0.
 Qed.
 
 Lemma area3_change_ext a b a' b' p :
-  p_x a < p_x b -> p_x a' < p_x b' ->
+  a.x < b.x -> a'.x < b'.x ->
   area3 a' a b == 0 -> area3 b' a b == 0 ->
   sg (area3 p a b) = sg (area3 p a' b').
 Proof.
@@ -1144,13 +1148,13 @@ move=> altb altb' ona onb.
 have/area3_triangle_on_edge:= ona => /(_ p)/eqP ona'.
 have/area3_triangle_on_edge:= onb => /(_ p)/eqP onb0.
 have/area3_triangle_on_edge: area3 b' a' a == 0.
-  have bna : p_x b != p_x a by case: ltrgtP altb.
+  have bna : b.x != a.x by case: ltrgtP altb.
   by rewrite (aligned_trans bna) //
        area3_opposite oppr_eq0 area3_cycle.
 move=>/(_ p)/eqP onb'.
-have difab : 0 < p_x b - p_x a by rewrite subr_gt0.
-have difab' : 0 < p_x b' - p_x a' by rewrite subr_gt0.
-have [ | | aa' ] := ltrgtP (p_x a) (p_x a'); last first.
+have difab : 0 < b.x - a.x by rewrite subr_gt0.
+have difab' : 0 < b'.x - a'.x by rewrite subr_gt0.
+have [ | | aa' ] := ltrgtP (a.x) (a'.x); last first.
 - set w := Bedge altb.
   have/on_edge_same_point tmp : a === Bedge altb by exact: left_on_edge.
   have/(tmp _) : a' === Bedge altb.
@@ -1201,14 +1205,14 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => puep.
 
-have ydiff : p_y p <= p_y p'.
+have ydiff : p.y <= p'.y.
   by rewrite -(under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
 have puep' := (point_on_edge_under  poep' pulh purh).
-have y'diff : p_y p' <= p_y p''.
+have y'diff : p'.y <= p''.y.
   by rewrite -(under_edge_lower_y eqx'' poep'').
-have y''diff: (p_y p  <= p_y p'').
+have y''diff: (p.y  <= p''.y).
   by rewrite (le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
@@ -1218,14 +1222,14 @@ rewrite -area3_cycle in pHreq.
 rewrite area3_opposite -area3_cycle in pHleq.
 
 move : poepf'' pHreq => /eqP ->  -> .
-have :  area3 p hl p'' = - ((p_x p - p_x hl) * (p_y p'' - p_y p)).
+have :  area3 p hl p'' = - ((p.x - hl.x) * (p''.y - p.y)).
   by rewrite -pHleq opprK.
 move => ->.
 rewrite add0r -mulrBl.
 rewrite  [x in (x - _) * _ == _] addrC.
 rewrite addrKA opprK.
 
-rewrite /point_under_edge /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
+rewrite /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
 rewrite underE.
 rewrite addrC.
 have inH' := inH.
@@ -1261,14 +1265,14 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => puep.
 
-have ydiff : p_y p < p_y p'.
+have ydiff : p.y < p'.y.
   by rewrite -(strict_under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
 have puep' := (point_on_edge_under  poep' pulh purh).
-have y'diff : p_y p' <= p_y p''.
+have y'diff : p'.y <= p''.y.
   by rewrite -(under_edge_lower_y eqx'' poep'').
-have y''diff: (p_y p  < p_y p'').
+have y''diff: (p.y  < p''.y).
   by rewrite (lt_le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
@@ -1278,14 +1282,14 @@ rewrite -area3_cycle in pHreq.
 rewrite area3_opposite -area3_cycle in pHleq.
 
 move : poepf'' pHreq => /eqP ->  -> .
-have :  area3 p hl p'' = - ((p_x p - p_x hl) * (p_y p'' - p_y p)).
+have :  area3 p hl p'' = - ((p.x - hl.x) * (p''.y - p.y)).
   by rewrite -pHleq opprK.
 move => ->.
 rewrite add0r -mulrBl.
 rewrite  [x in (x - _) * _ == _] addrC.
 rewrite addrKA opprK.
 
-rewrite /point_strictly_under_edge /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
+rewrite /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
 rewrite addrC.
 have inH' := inH.
 rewrite -subr_cp0 in inH'.
@@ -1321,14 +1325,14 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => /= puep.
 
-have ydiff : p_y p <= p_y p'.
+have ydiff : p.y <= p'.y.
   by rewrite -(under_edge_lower_y eqx' poep').
 rewrite eqx' in eqx''.
 symmetry in eqx''.
 have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
-have y'diff : p_y p' <= p_y p''.
+have y'diff : p'.y <= p''.y.
   by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
-have y''diff: (p_y p  <= p_y p'').
+have y''diff: (p.y  <= p''.y).
   by rewrite (le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
@@ -1339,14 +1343,14 @@ rewrite area3_opposite in pHreq.
 rewrite area3_cycle in pHleq.
 
 move : poepf'' pHleq => /eqP  ->  -> .
-have :  area3 p p'' hr = - ((p_x p'' - p_x hr) * (p_y p - p_y p'')).
+have :  area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)).
   by rewrite -pHreq opprK.
 move => ->.
 rewrite add0r addrC -mulrBl.
 rewrite  [x in (x - _) * _ == _] addrC.
 rewrite addrKA opprK.
 
-rewrite /point_under_edge /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
+rewrite /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
 rewrite addrC.
 have inH' := inH.
 rewrite -subr_gte0 in inH'.
@@ -1382,15 +1386,15 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => /= puep.
 
-have ydiff : p_y p < p_y p'.
+have ydiff : p.y < p'.y.
   by rewrite -(strict_under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
 symmetry in eqx''.
 have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
-have y'diff : p_y p' <= p_y p''
+have y'diff : p'.y <= p''.y
    by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
-have y''diff: (p_y p  < p_y p'').
+have y''diff: (p.y  < p''.y).
   by rewrite (lt_le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
@@ -1401,14 +1405,14 @@ rewrite area3_opposite in pHreq.
 rewrite area3_cycle in pHleq.
 
 move : poepf'' pHleq => /eqP  ->  -> .
-have :  area3 p p'' hr = - ((p_x p'' - p_x hr) * (p_y p - p_y p'')).
+have :  area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)).
   by rewrite -pHreq opprK.
 move => ->.
 rewrite add0r addrC -mulrBl.
 rewrite  [x in (x - _) * _ == _] addrC.
 rewrite addrKA opprK.
 
-rewrite /point_strictly_under_edge /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
+rewrite /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
 rewrite addrC.
 have inH' := inH.
 rewrite -subr_gte0 in inH'.
@@ -1450,18 +1454,17 @@ rewrite /edge_below => /orP [] /andP [].
   set B := right_pt low_e.
   move => pueplow puephigh.
   move =>  inf0.
-  have:= inf0; rewrite /point_strictly_under_edge.
-  rewrite strictE.
+  have:= inf0; rewrite strictE.
   move=> /ltW; rewrite -/A -/B => infeq0.
   have := (under_low_imp_strict_under_high pueplow puephigh vallow valhigh inf0).
-  by rewrite /point_strictly_under_edge strictE.
+  by rewrite strictE.
 move=> pueplow puephigh.
 move=> inf0.
 by have := (under_low_imp_strict_under_high_bis pueplow puephigh vallow valhigh inf0).
 Qed.
 
 Lemma edge_dir_intersect p1 p2 e1 :
-  p_x p1 != p_x p2 ->
+  p1.x != p2.x ->
   ~~(p1 <<= e1) -> p2 <<< e1 ->
  exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\
       area3 p p1 p2 = 0 /\
@@ -1469,13 +1472,13 @@ Lemma edge_dir_intersect p1 p2 e1 :
        area3 q p1 p2 = 0 -> p = q).
 Proof.
 move=> dif12.
-rewrite /point_under_edge underE.
+rewrite underE.
 rewrite area3E -ltNge => ca.
-rewrite /point_strictly_under_edge strictE.
+rewrite strictE.
 rewrite area3E => cu.
 have [px [py []]] := line_intersection dif12 ca cu.
-rewrite -/(p_y (Bpt px py)); set py' := (p_y (Bpt px py)).
-rewrite -/(p_x (Bpt px py)) /py' {py'}.
+rewrite -/((Bpt px py).y); set py' := ((Bpt px py).y).
+rewrite -/((Bpt px py).x) /py' {py'}.
 move: ca cu; rewrite -4!area3E=> ca cu on_line1 [] on_line2 uniq.
 exists (Bpt px py); rewrite on_line1 on_line2;split;[ | split]=> //.
 by move=> [qx qy]; rewrite !area3E=> /uniq => U; move=> {}/U[] /= -> ->.
@@ -1486,8 +1489,8 @@ Lemma intersection_middle_au e1 e2 :
   exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\ p === e2.
 Proof.
 move=> /[dup] ca; rewrite -ltNge subrr=> ca' /[dup] cu cu'.
-rewrite /point_strictly_under_edge strictE in cu'.
-have le2xnre2x : p_x (left_pt e2) != p_x (right_pt e2).
+rewrite strictE in cu'.
+have le2xnre2x : (left_pt e2).x != (right_pt e2).x.
   by have := edge_cond e2; rewrite lt_neqAle=> /andP[].
 have [p [p1 [p2 pu]]] := edge_dir_intersect le2xnre2x ca cu.
 exists p; rewrite p1; split=> //.
@@ -1496,7 +1499,7 @@ rewrite /generic_trajectories.valid_edge.
 have/eqP ol2 := p2.
 have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
 rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
-case : (ltP (p_x p) (p_x (right_pt e2))).
+case : (ltP (p.x) ((right_pt e2).x)).
   move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
   rewrite -(pmulr_lgt0 _ ca') signcond.
   by rewrite nmulr_lgt0 // => /ltW.
@@ -1510,8 +1513,8 @@ Lemma intersection_middle_ua e1 e2 :
   exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\ p === e2.
 Proof.
 move=> /[dup] cu cu' /[dup] ca; rewrite -ltNge subrr=> ca'.
-rewrite /point_strictly_under_edge strictE in cu'.
-have re2xnle2x : p_x (right_pt e2) != p_x (left_pt e2).
+rewrite strictE in cu'.
+have re2xnle2x : (right_pt e2).x != (left_pt e2).x.
   by have := edge_cond e2; rewrite lt_neqAle eq_sym=> /andP[].
 have [p [p1 [p2 pu]]] := edge_dir_intersect re2xnle2x ca cu.
 move: p2; rewrite area3_opposite area3_cycle => /eqP.
@@ -1521,7 +1524,7 @@ rewrite /point_on_edge p2 eqxx /= /valid_edge.
 rewrite /generic_trajectories.valid_edge.
 have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
 rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
-case : (ltP (p_x p) (p_x (right_pt e2))).
+case : (ltP (p.x) ((right_pt e2).x)).
   move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
   rewrite -(nmulr_llt0 _ cu') signcond.
   by rewrite pmulr_llt0 // => /ltW.
@@ -1531,10 +1534,10 @@ by rewrite pmulr_lge0 // subr_ge0=> /(le_trans re2lp); rewrite leNgt edge_cond.
 Qed.
 
 Definition lexPt (p1 p2 : pt) : bool :=
-  (p_x p1 < p_x p2) || ((p_x p1 == p_x p2) && (p_y p1 < p_y p2)).
+  (p1.x < p2.x) || ((p1.x == p2.x) && (p1.y < p2.y)).
 
 Definition lexePt (p1 p2 : pt) : bool :=
-    (p_x p1 < p_x p2) || ((p_x p1 == p_x p2) && (p_y p1 <= p_y p2)).
+    (p1.x < p2.x) || ((p1.x == p2.x) && (p1.y <= p2.y)).
 
 Lemma lexPtW p1 p2 :
   lexPt p1 p2 -> lexePt p1 p2.
@@ -1547,23 +1550,23 @@ Qed.
 Lemma lexePtNgt (p1 p2 : pt) : lexePt p1 p2 = ~~lexPt p2 p1.
 Proof.
 rewrite /lexePt /lexPt negb_or negb_and.
-rewrite andb_orr -leNgt (andbC (_ <= _)) (eq_sym (p_x p2)) -lt_neqAle.
-rewrite -leNgt (le_eqVlt (p_x p1)).
-by case: (p_x p1 < p_x p2) => //; rewrite ?orbF //=.
+rewrite andb_orr -leNgt (andbC (_ <= _)) (eq_sym (p2.x)) -lt_neqAle.
+rewrite -leNgt (le_eqVlt (p1.x)).
+by case: (p1.x < p2.x) => //; rewrite ?orbF //=.
 Qed.
 
 Lemma lexPtNge (p1 p2 : pt) : lexPt p1 p2 = ~~lexePt p2 p1.
 Proof.
 rewrite /lexePt /lexPt.
-rewrite negb_or -leNgt negb_and (eq_sym (p_x p2)) andb_orr (andbC (_ <= _)).
+rewrite negb_or -leNgt negb_and (eq_sym (p2.x)) andb_orr (andbC (_ <= _)).
 rewrite -lt_neqAle le_eqVlt -ltNge.
-by case: (p_x p1 < p_x p2); rewrite // ?orbF.
+by case: (p1.x < p2.x); rewrite // ?orbF.
 Qed.
 
 Lemma lexePt_eqVlt (p1 p2 :pt) : lexePt p1 p2 = (p1 == p2) || lexPt p1 p2.
 Proof.
 rewrite /lexePt /lexPt.
-case: (ltrgtP (p_x p1) (p_x p2))=> cnd; rewrite ?orbT //= ?orbF.
+case: (ltrgtP (p1.x) (p2.x))=> cnd; rewrite ?orbT //= ?orbF.
   by apply/esym/negP=> /eqP p1p2; move: cnd; rewrite p1p2 ltxx.
 apply/idP/idP.
   rewrite orbC le_eqVlt=> /orP[/eqP | ->// ].
@@ -1618,7 +1621,7 @@ move => p2 p1 p3; rewrite lexePt_eqVlt => /orP[/eqP-> // | p1p2] p2p3.
 by apply/lexPtW/(lexPt_lexePt_trans p1p2).
 Qed.
 
-Lemma lexePt_xW p1 p2 : lexePt p1 p2 -> p_x p1 <= p_x p2.
+Lemma lexePt_xW p1 p2 : lexePt p1 p2 -> p1.x <= p2.x.
 Proof.
 by rewrite /lexePt=> /orP[/ltW | /andP [/eqP -> _]].
 Qed.
@@ -1627,7 +1630,7 @@ Lemma on_edge_lexePt_left_pt (p : pt) g :
   p === g -> lexePt (left_pt g) p.
 Proof.
 move=> on.
-have : p_x (left_pt g) <= p_x p by move: on=> /andP[] _ /andP[].
+have : (left_pt g).x <= p.x by move: on=> /andP[] _ /andP[].
 rewrite le_eqVlt=> /orP[/eqP/esym /[dup] samex' /eqP samex | xlt ].
  have/eqP samey := on_edge_same_point on (left_on_edge _) samex.
   have -> : p = left_pt g.
@@ -1643,8 +1646,7 @@ Proof.
 case: e1 => [d [a_x a_y] /= cpa].
 case: e2 => [d' [b_x b_y] /= cpb].
 case: e3 => [d'' [c_x c_y] /= cpc] dp d'p d''p.
-rewrite /edge_below /point_under_edge /point_strictly_under_edge.
-rewrite !underE !strictE.
+rewrite /edge_below !underE !strictE.
 rewrite !area3E; simpl left_pt; simpl right_pt.
 move: cpa cpb cpc; rewrite dp d'p d''p {dp d'p d''p}.
 case: p=> [px py]; simpl p_x; simpl p_y=> cpa cpb cpc.
@@ -1680,36 +1682,36 @@ move=> nc ve.
 case: (exists_point_valid ve) => [p pP].
 move: (intersection_on_edge pP)=> [pone2 px].
 move: (pone2); rewrite /point_on_edge=> /andP[] pone2' vp.
-have xbnd1 : p_x (left_pt e2) <= p_x (left_pt e1) by case/andP: ve.
-have xbnd2 : p_x (left_pt e1) <= p_x (right_pt e2) by case/andP: ve.
-have dify : ((left_pt e1 <<< e2) \/ (~~(left_pt e1 <<= e2))) -> p_y (left_pt e1) != p_y p.
+have xbnd1 : (left_pt e2).x <= (left_pt e1).x by case/andP: ve.
+have xbnd2 : (left_pt e1).x <= (right_pt e2).x by case/andP: ve.
+have dify : ((left_pt e1 <<< e2) \/ (~~(left_pt e1 <<= e2))) -> (left_pt e1).y != p.y.
   move=> disj; apply/negP=> /eqP A.
   have {A}-A : p = left_pt e1 by case: (p) (left_pt e1) px A=> [? ?][? ?]/= -> ->.
   by move: disj; rewrite under_onVstrict // strict_nonAunder // -A pone2; case.
-have pone2'': pue_f (p_x (left_pt e2)) (p_y (left_pt e2))
-             (p_x (right_pt e2)) (p_y (right_pt e2))
-             (p_x p) (p_y p) == 0.
+have pone2'': pue_f ((left_pt e2).x) ((left_pt e2).y)
+             ((right_pt e2).x) ((right_pt e2).y)
+             (p.x) (p.y) == 0.
   by rewrite -pue_f_c; move: pone2'; rewrite area3E pue_f_c.
-move: (edge_cond e2); rewrite -(subr_gt0 (p_x _))=> ce2.
-have dife2 : 0 < p_x (right_pt e2) - p_x (left_pt e2).
-  by move: (edge_cond e2); rewrite -(subr_gt0 (p_x _)).
-have dife2' : p_x (right_pt e2) - p_x (left_pt e2) != 0.
+move: (edge_cond e2); rewrite -(subr_gt0 (_.x))=> ce2.
+have dife2 : 0 < (right_pt e2).x - (left_pt e2).x.
+  by move: (edge_cond e2); rewrite -(subr_gt0 (_.x)).
+have dife2' : (right_pt e2).x - (left_pt e2).x != 0.
   by move: dife2; rewrite  lt_neqAle eq_sym=> /andP[].
-have plp2 : p_x (left_pt e2) = p_x (left_pt e1) -> p = left_pt e2.
+have plp2 : (left_pt e2).x = (left_pt e1).x -> p = left_pt e2.
   move=> c; have:= on_edge_same_point pone2 (left_on_edge _).
   rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
   by case: (p) (left_pt e2)=> [? ?][? ?]/= <- <- ->.
-have prp2 : p_x (right_pt e2) = p_x (left_pt e1) -> p = right_pt e2.
+have prp2 : (right_pt e2).x = (left_pt e1).x -> p = right_pt e2.
   move=> c; have:= on_edge_same_point pone2 (right_on_edge _).
   rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
   by case: (p) (right_pt e2)=> [? ?][? ?]/= <- <- ->.
 have main : (0 < area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
-       (p_y p < p_y (left_pt e1)).
+       (p.y < (left_pt e1).y).
   move: xbnd1; rewrite le_eqVlt=> /orP[/eqP atleft | notleft ].
     have pisl : p = left_pt e2 by apply: plp2.
     move: atleft; rewrite -pisl=> atleft; rewrite edge_and_left_vertical //.
     by rewrite -atleft pisl (edge_cond e2).
-  have fact1 : (0 < p_x p - p_x (left_pt e2)) by rewrite subr_gt0 -px.
+  have fact1 : (0 < p.x - (left_pt e2).x) by rewrite subr_gt0 -px.
   rewrite -(pmulr_rgt0 _ fact1) area3_opposite mulrN.
   rewrite -(eqP (area3_triangle_on_edge (left_pt e1) pone2')) -mulrN.
   rewrite -area3_opposite area3_cycle pmulr_rgt0 //.
@@ -1720,24 +1722,25 @@ have arith : forall (a b : R), a <= 0 -> b <= 0 -> a + b <= 0.
 have case1 : left_pt e1 <<< e2 -> e1 <| e2.
   move=> below; case:(nc) => // /orP[]; last by rewrite below.
   move/andP=> []le2b re2b.
-  have pyne1 : p_y (left_pt e1) != p_y p by apply: dify; left.
-  have ys : p_y (left_pt e1) < p_y p.
+  have pyne1 : (left_pt e1).y != p.y by apply: dify; left.
+  have ys : (left_pt e1).y < p.y.
     rewrite ltNge le_eqVlt -main negb_or eq_sym pyne1 /= -leNgt le_eqVlt.
-    by move: (below); rewrite /point_strictly_under_edge strictE orbC => ->.
+    by move: (below); rewrite strictE orbC => ->.
   have : 0 < area3 p (left_pt e1) (right_pt e1).
     by rewrite edge_and_left_vertical // -px (edge_cond e1).
   rewrite -(pmulr_rgt0 _ ce2).
   rewrite (eqP (area3_on_edge (left_pt e1) (right_pt e1) pone2')).
   rewrite ltNge arith //.
     apply: mulr_ge0_le0; first by rewrite -px subr_ge0.
-    by move: re2b; rewrite /point_under_edge underE -area3_cycle.
+    by move: re2b; rewrite underE -area3_cycle.
   apply: mulr_ge0_le0; first by rewrite -px subr_ge0.
-  by move: le2b; rewrite /point_under_edge underE -area3_cycle.
+  by move: le2b;
+    rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
 suff case2 : ~~(left_pt e1 <<= e2) -> e2 <| e1 by [].
 move=> above; case: (nc) => // /orP[]; first by rewrite (negbTE above).
-rewrite /point_strictly_under_edge !strictE -!leNgt => /andP[] le2a re2a.
-have pyne1 : p_y (left_pt e1) != p_y p by apply: dify; right.
-have ys : p_y p < p_y (left_pt e1).
+rewrite !strictE -!leNgt => /andP[] le2a re2a.
+have pyne1 : (left_pt e1).y != p.y by apply: dify; right.
+have ys : p.y < (left_pt e1).y.
   by rewrite -main;move: (above); rewrite /point_under_edge -ltNge subrr.
 have : 0 < area3 (left_pt e1) p (right_pt e1).
   by rewrite edge_and_left_vertical // (edge_cond e1).
@@ -1755,7 +1758,7 @@ Proof.
 move=> nc e1 e2 e1in e2in.
 have nc' := inter_at_ext_sym nc.
 have ceq : e1 = e2 -> below_alt e1 e2.
-  move=> <-; left; apply/orP; left; rewrite /point_under_edge !underE.
+  move=> <-; left; apply/orP; left; rewrite !underE.
   rewrite (fun a b => eqP (proj1 (area3_two_points a b))).
   rewrite (fun a b => eqP (proj1 (proj2 (area3_two_points a b)))).
   by rewrite lexx.
@@ -1766,8 +1769,8 @@ have [ | ] := boolP(e1 <| e2); first by left.
 have [ | ] := boolP(e2 <| e1); first by right.
 rewrite /edge_below.
 rewrite !negb_or. rewrite 4!negb_and !negbK.
-rewrite /edge_below/point_under_edge !underE.
-rewrite /point_strictly_under_edge !strictE => noc.
+rewrite /edge_below !underE.
+rewrite !strictE => noc.
 suff [it | [p [pone1 pone2]]] :
   below_alt e1 e2 \/ exists p, p === e1 /\ p === e2; first by [].
   have : p \in [:: left_pt e1; right_pt e1] by apply: nc.
@@ -1790,15 +1793,15 @@ move: noc {nc nc'} => /andP[] /orP[le2a | re2a].
     by rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
   have [ re2u | re2a _] := boolP(right_pt e2 <<< e1); last first.
     by left; left; apply/orP; right; rewrite re2a underWC.
-  have dif2 : p_x (left_pt e2) != p_x (right_pt e2).
+  have dif2 : (left_pt e2).x != (right_pt e2).x.
     by have := edge_cond e2; rewrite lt_neqAle => /andP[].
   have [r [_ [ _ uniq]]] := edge_dir_intersect dif2 le2a' re2u.
   move=> /orP[le1u | re1u].
     have [re1u | re1a] := boolP(right_pt e1 <<= e2).
       left; left; apply/orP; left; rewrite re1u underW //.
-      by rewrite /point_strictly_under_edge strictE.
+      by rewrite strictE.
     have le1u' : left_pt e1 <<< e2.
-      by rewrite /point_strictly_under_edge strictE.
+      by rewrite strictE.
     have [p [pe2 pe1]] := intersection_middle_ua le1u' re1a.
     have [q [qe1 qe2]] := intersection_middle_au le2a' re2u.
     move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP qe2' _.
@@ -1806,10 +1809,10 @@ move: noc {nc nc'} => /andP[] /orP[le2a | re2a].
     by right; exists r; rewrite [X in X === e2]rq rp.
   have [le1u | le1a] := boolP(left_pt e1 <<= e2).
       left; left; apply/orP; left; rewrite le1u underW //.
-      by rewrite /point_strictly_under_edge strictE.
+      by rewrite strictE.
   have [q [qe1 qe2]] := intersection_middle_au le2a' re2u.
   have re1u' : right_pt e1 <<< e2.
-    by rewrite /point_strictly_under_edge strictE.
+    by rewrite strictE.
   have [p [pe2 pe1]] := intersection_middle_au le1a re1u'.
   move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP qe2' _.
   have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
@@ -1818,7 +1821,7 @@ have re2a' : right_pt e2 >>> e1.
   by rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
 have [ le2u | le2a _] := boolP(left_pt e2 <<< e1); last first.
   by left; left; apply/orP; right; rewrite le2a underWC.
-have dif2 : p_x (right_pt e2) != p_x (left_pt e2).
+have dif2 : (right_pt e2).x != (left_pt e2).x.
   by have := edge_cond e2; rewrite lt_neqAle eq_sym => /andP[].
 have [r [_ [ _ uniq]]] := edge_dir_intersect dif2 re2a' le2u.
 have transfer a b c : area3 a b c = 0 -> area3 a c b = 0.
@@ -1826,9 +1829,9 @@ have transfer a b c : area3 a b c = 0 -> area3 a c b = 0.
 move=> /orP[le1u | re1u].
   have [re1u | re1a] := boolP(right_pt e1 <<= e2).
     left; left; apply/orP; left; rewrite re1u underW //.
-    by rewrite /point_strictly_under_edge strictE.
+    by rewrite strictE.
   have le1u' : left_pt e1 <<< e2.
-    by rewrite /point_strictly_under_edge strictE.
+    by rewrite strictE.
   have [p [/transfer pe2 pe1]] := intersection_middle_ua le1u' re1a.
   have [q [qe1 qe2]] := intersection_middle_ua le2u re2a'.
   move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP /transfer qe2' _.
@@ -1836,10 +1839,10 @@ move=> /orP[le1u | re1u].
   by right; exists r; rewrite [X in X === e2]rq rp.
 have [le1u | le1a] := boolP(left_pt e1 <<= e2).
   left; left; apply/orP; left; rewrite le1u underW //.
-  by rewrite /point_strictly_under_edge strictE.
+  by rewrite strictE.
 have [q [qe1 qe2]] := intersection_middle_ua le2u re2a'.
 have re1u' : right_pt e1 <<< e2.
-  by rewrite /point_strictly_under_edge strictE.
+  by rewrite strictE.
 have [p [/transfer pe2 pe1]] := intersection_middle_au le1a re1u'.
 move: (pe1) (qe2)=> /andP[] /eqP pe1' _ /andP[] /eqP /transfer qe2' _.
 have rq := uniq _ qe1 qe2'; have rp := uniq _ pe1' pe2.
@@ -1866,33 +1869,33 @@ exact: (sub_in2 oesub).
 Qed.
 
 Lemma common_point_edges_y_left r r1 r2 e1 e2 :
-   valid_edge e1 r -> p_x r <= p_x (left_pt e1) ->
-     p_x r = p_x r1 -> p_x r = p_x r2 -> left_pt e1 === e2 ->
+   valid_edge e1 r -> r.x <= (left_pt e1).x ->
+     r.x = r1.x -> r.x = r2.x -> left_pt e1 === e2 ->
      r1 === e1 -> r2 === e2 ->
-     p_y r1 = p_y r2.
+     r1.y = r2.y.
 Proof.
 move=> v xl rr1 rr2 e1e2 re1 re2.
-have xl': p_x r = p_x (left_pt e1) by apply: le_anti; rewrite xl; case/andP:v.
+have xl': r.x = (left_pt e1).x by apply: le_anti; rewrite xl; case/andP:v.
 have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
 have:= on_edge_same_point (left_on_edge _) re1.
 by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
 Qed.
 
 Lemma common_point_edges_y_right r r1 r2 e1 e2 :
- valid_edge e1 r -> p_x (right_pt e1) <= p_x r ->
-     p_x r = p_x r1 -> p_x r = p_x r2 -> right_pt e1 === e2 ->
+ valid_edge e1 r -> (right_pt e1).x <= r.x ->
+     r.x = r1.x -> r.x = r2.x -> right_pt e1 === e2 ->
      r1 === e1 -> r2 === e2 ->
-     p_y r1 = p_y r2.
+     r1.y = r2.y.
 Proof.
 move=> v xl rr1 rr2 e1e2 re1 re2.
-have xl': p_x r = p_x (right_pt e1).
+have xl': r.x = (right_pt e1).x.
   by apply: le_anti; rewrite xl andbC; case/andP:v.
 have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
 have:= on_edge_same_point (right_on_edge _) re1.
   by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
 Qed.
 
-Lemma expand_valid p q (pq : p_x p < p_x q) e r :
+Lemma expand_valid p q (pq : p.x < q.x) e r :
   valid_edge (Bedge pq) r ->
   valid_edge e p -> valid_edge e q -> valid_edge e r.
 Proof.
@@ -1912,7 +1915,7 @@ move=> noc val pue1 pae2 qae1; apply/negP=> que2; set v := valid_edge.
 have : [/\ v e1 p, v e2 p, v e1 q & v e2 q].
   by split; apply: val; rewrite !inE eqxx ?orbT.
 have pr e r: valid_edge e r ->
-   exists r', [/\ valid_edge e r, r' === e & p_x r = p_x r'].
+   exists r', [/\ valid_edge e r, r' === e & r.x = r'.x].
     move=>/[dup]vr/exists_point_valid[r' /intersection_on_edge [one xx]].
     by exists r'; constructor.
 move=>[]/pr[p1 [vp1 pone1 p1p]] /pr[p2 [vp2 pone2 p2p]].
@@ -1920,20 +1923,20 @@ move=> /pr[q1 [vq1 qone1 q1q]] /pr[q2 [vq2 qone2 q2q]].
 move: vp1 vp2 vq1 vq2 p1p p2p q1q q2q=>vp1 vp2 vq1 vq2 p1p p2p q1q q2q.
 move: pone1 pone2 qone1 qone2=>pone1 pone2 qone1 qone2 {pr v val}.
 set abbrev := strict_under_edge_lower_y.
-have pylt : p_y p < p_y p1 by rewrite -(abbrev _ _ _ _ pone1).
-have pyge : p_y p2 <= p_y p by rewrite leNgt -(abbrev _ _ _ _ pone2).
-have qyge : p_y q1 <= p_y q by rewrite leNgt -(abbrev _ _ _ _ qone1).
-have qylt : p_y q < p_y q2 by rewrite -(abbrev _ _ _ _ qone2).
-have yp : p_y p2 < p_y p1 by rewrite (le_lt_trans pyge).
-have yq : p_y q1 < p_y q2 by rewrite (le_lt_trans qyge).
+have pylt : p.y < p1.y by rewrite -(abbrev _ _ _ _ pone1).
+have pyge : p2.y <= p.y by rewrite leNgt -(abbrev _ _ _ _ pone2).
+have qyge : q1.y <= q.y by rewrite leNgt -(abbrev _ _ _ _ qone1).
+have qylt : q.y < q2.y by rewrite -(abbrev _ _ _ _ qone2).
+have yp : p2.y < p1.y by rewrite (le_lt_trans pyge).
+have yq : q1.y < q2.y by rewrite (le_lt_trans qyge).
 move=> {pyge qyge pylt qylt abbrev}.
-have [/[dup]p1p2 + /[dup] q1q2 +] : [/\ p_x p1 == p_x p2 & p_x q1 == p_x q2].
+have [/[dup]p1p2 + /[dup] q1q2 +] : [/\ p1.x == p2.x & q1.x == q2.x].
   by rewrite -p1p p2p -q1q q2q !eqxx.
 move=>/eqP/esym/eqP p2p1 /eqP/esym/eqP q2q1.
 move: (pone1) (pone2) (qone1) (qone2).
 move=>/andP[]pl1 _ /andP[]pl2 _ /andP[]ql1 _ /andP[] ql2 _.
-have [pltq | qltp | pq ] := ltrgtP (p_x p) (p_x q).
-- have [p1q1 p2q2] : p_x p1 < p_x q1 /\ p_x p2 < p_x q2.
+have [pltq | qltp | pq ] := ltrgtP (p.x) (q.x).
+- have [p1q1 p2q2] : p1.x < q1.x /\ p2.x < q2.x.
     by rewrite -p1p -q1q -p2p -q2q .
   set e3 := Bedge p1q1; set e4 := Bedge p2q2.
   have l3a : ~~(left_pt e3 <<= e4).
@@ -1962,7 +1965,7 @@ have [pltq | qltp | pq ] := ltrgtP (p_x p) (p_x q).
     by move: yp; rewrite abs ltxx.
   have abs := right_ext _ _ _ vq1 piq q1q q2q pi2 qone1 qone2.
   by move: yq; rewrite abs ltxx.
-- have [q1p1 q2p2] : p_x q1 < p_x p1 /\ p_x q2 < p_x p2.
+- have [q1p1 q2p2] : q1.x < p1.x /\ q2.x < p2.x.
     by rewrite -p1p -q1q -p2p -q2q .
   set e3 := Bedge q1p1; set e4 := Bedge q2p2.
   have l3u : left_pt e3 <<< e4.
@@ -1998,12 +2001,12 @@ Qed.
 
 Definition pvert_y (p : pt) (e : edge) :=
   match vertical_intersection_point p e with
-    Some p' => p_y p'
+    Some p' => p'.y
   | None => 0
   end.
 
 Lemma pvertE p e : valid_edge e p ->
-  vertical_intersection_point p e = Some (Bpt (p_x p) (pvert_y p e)).
+  vertical_intersection_point p e = Some (Bpt (p.x) (pvert_y p e)).
 Proof.
 move=> vep; rewrite /pvert_y.
 have [p' p'P] := exists_point_valid vep; rewrite p'P.
@@ -2012,7 +2015,7 @@ by rewrite pxq; case: (p') one.
 Qed.
 
 Lemma pvert_on p e : valid_edge e p ->
-  Bpt (p_x p) (pvert_y p e) === e.
+  Bpt (p.x) (pvert_y p e) === e.
 Proof.
 move=> vep; rewrite /pvert_y.
 have [p' p'P] := exists_point_valid vep; rewrite p'P.
@@ -2020,17 +2023,17 @@ have [one pxq] := intersection_on_edge p'P.
 by rewrite pxq; case: (p') one.
 Qed.
 
-Definition on_pvert p e : p === e -> pvert_y p e = p_y p.
+Definition on_pvert p e : p === e -> pvert_y p e = p.y.
 Proof.
 move=> /[dup]/andP[] _ vpe pone.
 by have := on_edge_same_point pone (pvert_on vpe) (eqxx _) => /eqP ->.
 Qed.
 
 Definition cmp_slopes e1 e2 :=
-  sg((p_y (right_pt e2) - p_y (left_pt e2)) * 
-     (p_x (right_pt e1) -p_x (left_pt e1)) - 
-     (p_y (right_pt e1) - p_y (left_pt e1)) * 
-     (p_x (right_pt e2) - p_x (left_pt e2))).
+  sg(((right_pt e2).y - (left_pt e2).y) * 
+     ((right_pt e1).x -(left_pt e1).x) - 
+     ((right_pt e1).y - (left_pt e1).y) * 
+     ((right_pt e2).x - (left_pt e2).x)).
 
 Definition pedge_below p e1 e2 := 
   (pvert_y p e1 < pvert_y p e2) || 
@@ -2045,9 +2048,9 @@ Lemma same_left_edge_below_slopes e1 e2 :
   e1 <| e2 = (0 <= cmp_slopes e1 e2).
 Proof.
 move=> sameleft.
-rewrite /edge_below/point_under_edge !underE [in X in X || _]sameleft.
+rewrite /edge_below !underE [in X in X || _]sameleft.
 rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
-rewrite /point_strictly_under_edge !strictE -[in X in _ || X]sameleft -!leNgt.
+rewrite !strictE -[in X in _ || X]sameleft -!leNgt.
 rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
 rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
 rewrite  /cmp_slopes sameleft -opprB oppr_le0.
@@ -2062,18 +2065,18 @@ Lemma same_right_edge_below_slopes e1 e2 :
   e1 <| e2 = (cmp_slopes e1 e2 <= 0).
 Proof.
 move=> sameright.
-rewrite /edge_below/point_under_edge !underE [in X in X || _]sameright.
+rewrite /edge_below !underE [in X in X || _]sameright.
 rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /=.
-rewrite /point_strictly_under_edge !strictE -[in X in _ || X]sameright -!leNgt.
+rewrite !strictE -[in X in _ || X]sameright -!leNgt.
 rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /= !andbT.
 rewrite !area3E !(proj2 (pue_f_eq_slopes _ _ _ _ _ _)).
 rewrite /cmp_slopes sameright oppr_le0 opprB.
-rewrite !(mulrC (p_y (right_pt e2) - _)) orbb.
+rewrite !(mulrC ((right_pt e2).y - _)) orbb.
 by rewrite sgr_le0 -oppr_ge0 [X in _ = (0 <= X)]opprB.
 Qed.
 
 Definition slope e :=
-  (p_y (right_pt e) - p_y (left_pt e)) / (p_x (right_pt e) - p_x (left_pt e)).
+  ((right_pt e).y - (left_pt e).y) / ((right_pt e).x - (left_pt e).x).
 
 Lemma cmp_slopesE e1 e2 :
   cmp_slopes e1 e2 = sg(slope e2 - slope e1).
@@ -2088,10 +2091,10 @@ rewrite [X in sg(X)]mulrBr 2![in X in sg(X - _)]mulrA.
 rewrite [X in sg( X * _ * _ - _)]mulrC.
 rewrite 2![in X in sg(_ - X)]mulrA.
 rewrite /cmp_slopes.
-set V := (p_x (right_pt e1) - _).
-set W := (p_x (right_pt e2) - _).
-set U := (p_y _ - _).
-set Z := (p_y _ - _).
+set V := ((right_pt e1).x - _).
+set W := ((right_pt e2).x - _).
+set U := (_.y - _).
+set Z := (_.y - _).
 have den20 : W != 0 by rewrite -sgr_eq0 den2 oner_neq0.
 have den10 : V != 0 by rewrite -sgr_eq0 den1 oner_neq0.
 by rewrite (mulrAC V) mulfK // (mulrAC W) mulfK // (mulrC U) (mulrC Z).
@@ -2109,8 +2112,8 @@ have := edge_cond e1.
 have := edge_cond e1'.
   rewrite -subr_gt0 => den1'.
 rewrite subr_eq0.
-set W := (p_x _ - _).
-set V := (p_x _ - _).
+set W := (_.x - _).
+set V := (_.x - _).
 have den10 : W != 0.
   by rewrite subr_eq0 eq_sym -subr_eq0 lt0r_neq0 // den1.
 have den10v : W ^-1 != 0 by rewrite invr_eq0.
@@ -2135,8 +2138,8 @@ have := edge_cond e1.
 have := edge_cond e1'.
   rewrite -subr_gt0 => den1'.
 rewrite subr_eq0.
-set W := (p_x _ - _).
-set V := (p_x _ - _).
+set W := (_.x - _).
+set V := (_.x - _).
 have den10 : W != 0.
   by rewrite subr_eq0 -subr_eq0 lt0r_neq0 // den1.
 have den10v : W ^-1 != 0 by rewrite invr_eq0.
@@ -2160,7 +2163,7 @@ move=> /[dup] on2 /andP[] form val.
 suff area3_eq :
   sg (area3 (right_pt e1) (left_pt e2) (right_pt e2)) =
   -(cmp_slopes e1 e2).
-  rewrite /point_under_edge !underE /point_strictly_under_edge !strictE.
+  rewrite !underE !strictE.
   rewrite -sgr_le0 area3_eq oppr_le0 sgr_ge0; split;[by [] |].
   by rewrite -sgr_lt0 area3_eq oppr_lt0 sgr_gt0.
 move: (val) => /andP[] _; rewrite le_eqVlt=> /orP[/eqP atr | le1ltre2].
@@ -2172,7 +2175,7 @@ move: (val) => /andP[] _; rewrite le_eqVlt=> /orP[/eqP atr | le1ltre2].
   rewrite area3_opposite area3_cycle.
   rewrite sgrN.
   rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
-  rewrite -eqps -(mulrC (p_y _ - _)).
+  rewrite -eqps -(mulrC (_.y - _)).
   rewrite -[X in _ = - sg (X * _ - _)]opprB -[X in _ = - sg (_ -  _ * X)]opprB.
   by rewrite mulrN mulNr -opprD opprB.
 set e2' := Bedge le1ltre2.
@@ -2183,7 +2186,7 @@ have on2' : left_pt e2' === e2 by exact: on2.
 rewrite cmp_slopesE  -(on_edge_same_slope_right on2')// -cmp_slopesE.
 rewrite cmp_slopesNC.
 rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)) /cmp_slopes.
-by rewrite /e2' /= [in LHS](mulrC (p_x _ - _)).
+by rewrite /e2' /= [in LHS](mulrC (_.x - _)).
 Qed.
 
 Lemma contact_right_slope e1 e2 :
@@ -2195,7 +2198,7 @@ move=> /[dup] on2 /andP[] form val.
 suff area3_eq :
   sg (area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
   cmp_slopes e1 e2.
-  rewrite /point_under_edge !underE /point_strictly_under_edge !strictE.
+  rewrite !underE !strictE.
   rewrite -area3_eq -[X in X = _ /\ _]sgr_le0; split; first by [].
   by rewrite -[LHS]sgr_lt0.
 move: (val) => /andP[] + _; rewrite le_eqVlt eq_sym=> /orP[/eqP atl | le2ltre1].
@@ -2205,7 +2208,7 @@ move: (val) => /andP[] + _; rewrite le_eqVlt eq_sym=> /orP[/eqP atl | le2ltre1].
     rewrite atl eqxx => /(_ isT) /eqP; move: (right_pt e1) (left_pt e2) atl.
     by move=> [] ? ? [] ? ? /= -> ->.
   rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
-  rewrite eqps (mulrC (p_x _ - _)).
+  rewrite eqps (mulrC (_.x - _)).
   rewrite -[X in _ = sg (_ * X - _)]opprB -[X in _ = sg (_ -  X * _)]opprB.
   by rewrite mulrN mulNr -opprD opprB.
 set e2' := Bedge le2ltre1.
@@ -2216,12 +2219,12 @@ have on2' : right_pt e2' === e2 by exact: on2.
 rewrite cmp_slopesE  -(on_edge_same_slope_left on2')// -cmp_slopesE.
 rewrite area3_opposite area3_cycle.
 rewrite area3E (proj1 (pue_f_eq_slopes _ _ _ _ _ _)) /cmp_slopes.
-rewrite /e2' /= [in LHS](mulrC (p_x _ - _)) opprB.
+rewrite /e2' /= [in LHS](mulrC (_.x - _)) opprB.
 by rewrite -4![in LHS](opprB (_ (right_pt e1))) 2!mulrNN.
 Qed.
 
 Lemma sub_edge_right (p : pt) (e : edge) : p === e ->
-  p_x p < p_x (right_pt e) ->
+  p.x < (right_pt e).x ->
   {e' | [/\ left_pt e' = p, right_pt e' = right_pt e &
         forall e2, cmp_slopes e' e2 = cmp_slopes e e2]}.
 Proof.
@@ -2231,7 +2234,7 @@ by rewrite (@on_edge_same_slope_right e (Bedge dif) one erefl).
 Qed.
 
 Lemma sub_edge_left (p : pt) (e : edge) : p === e ->
-  p_x (left_pt e) < p_x p ->
+  (left_pt e).x < p.x ->
   {e' | [/\ left_pt e' = left_pt e, right_pt e' = p &
         forall e2, cmp_slopes e' e2 = cmp_slopes e e2]}.
 Proof.
@@ -2242,8 +2245,8 @@ Qed.
 
 Lemma intersection_imp_crossing e1 e2 p :
   p === e1 -> p === e2 ->
-  p_x (left_pt e1) < p_x p -> p_x p < p_x (right_pt e1) ->
-  p_x (left_pt e2) < p_x p -> p_x p < p_x (right_pt e2) ->
+  (left_pt e1).x < p.x -> p.x < (right_pt e1).x ->
+  (left_pt e2).x < p.x -> p.x < (right_pt e2).x ->
   ~below_alt e1 e2 \/ cmp_slopes e1 e2 == 0.
 Proof.
 move=> on1 on2 l1ltp pltr1 l2ltp pltr2.
@@ -2268,7 +2271,7 @@ valid_edge low_e p -> valid_edge high_e p ->
 vertical_intersection_point p low_e = Some pl ->
 vertical_intersection_point p high_e = Some ph ->
 low_e <| high_e ->
-p_y pl <= p_y ph.
+pl.y <= ph.y.
 Proof.
 move => lowv highv vert_pl vert_ph luh.
 have := intersection_on_edge vert_pl => [][] poel lx_eq.
@@ -2283,13 +2286,13 @@ have := order_edges_viz_point' pllv  plhv luh.
 rewrite under_onVstrict // poel /= => [] /= plinfh.
 have pluh: pl <<= high_e .
   by apply plinfh.
-have px_eq : p_x pl = p_x ph.
+have px_eq : pl.x = ph.x.
   by rewrite -lx_eq -hx_eq /=.
 by rewrite -(under_edge_lower_y px_eq poeh).
 Qed.
 
 Lemma edge_below_equiv p (s : pred edge) :
-  {in s, forall e, valid_edge e p && (p_x p < p_x (right_pt e))} ->
+  {in s, forall e, valid_edge e p && (p.x < (right_pt e).x)} ->
   {in s &, no_crossing} ->
   {in s & , forall e1 e2: edge, (e1 <| e2) = pedge_below p e1 e2}.
 Proof.
@@ -2300,12 +2303,12 @@ move: (ve1)=> /pvert_on; rewrite -p1q=> on1.
 move=> /[dup] e2in /val /andP[] /[dup] ve2 /exists_point_valid [p2 p2P] re2.
 move: (p2P); rewrite (pvertE ve2) =>/esym[] p2q.
 move: (ve2)=> /pvert_on; rewrite -p2q=> on2; rewrite /pedge_below.
-have p1p2 : p_x p1 = p_x p2 by rewrite p1q p2q.
+have p1p2 : p1.x = p2.x by rewrite p1q p2q.
 have [vylt /= | vylt' /= | vyq] := ltrgtP.
 - case: (noc e1 e2 e1in e2in) => // abs.
   have := order_below_viz_vertical ve2 ve1 p2P p1P abs; rewrite leNgt.
   by rewrite p1q p2q /= vylt.
-- have re1' : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+- have re1' : p1.x < (right_pt e1).x by rewrite p1q.
   have p2u : p2 <<< e1.
     by rewrite (strict_under_edge_lower_y (esym p1p2)); rewrite // p2q p1q.
   have p1a : p1 >>> e2.
@@ -2324,12 +2327,12 @@ move: (ve1) => /andP[] + _; rewrite le_eqVlt=>/orP[/eqP pleft | pmid] /=.
       apply/esym/eqP; rewrite pt_eqE.
       by rewrite (on_edge_same_point (left_on_edge _) on2) pleft2 p2q eqxx.
     by apply: same_left_edge_below_slopes; rewrite -p1l pp.
-  have le2ltp2 : p_x (left_pt e2) < p_x p2 by rewrite p2q.
+  have le2ltp2 : (left_pt e2).x < p2.x by rewrite p2q.
   have [e2' [le2' re2' sle2']] := sub_edge_left on2 le2ltp2.
   have re2'e1 : right_pt e2' === e1 by rewrite re2' -pp.
   rewrite /edge_below.
   have := (contact_right_slope re2'e1) => /= -[] _; rewrite le2' sle2' => ->.
-  have p2ltre2 : p_x p2 < p_x (right_pt e2) by rewrite p2q.
+  have p2ltre2 : p2.x < (right_pt e2).x by rewrite p2q.
   have [e2'' [le2'' re2'' sle2'']] := sub_edge_right on2 p2ltre2.
   have le2''e1 : left_pt e2'' === e1 by rewrite le2'' -pp.
   have := (contact_left_slope le2''e1) => -[] _; rewrite re2'' sle2'' => ->.
@@ -2337,17 +2340,17 @@ move: (ve1) => /andP[] + _; rewrite le_eqVlt=>/orP[/eqP pleft | pmid] /=.
   set W := (X in _ || X); have [ | difslope] := boolP W.
     rewrite {}/W=>/le_anti/esym=>/eqP.
     by rewrite -cmp_slopesNC oppr_eq0 orbT=> /eqP->; rewrite lexx.
-  rewrite orbF -p1l pp {1}/point_under_edge underE.
+  rewrite orbF -p1l pp {1}underE.
   move: (on2); rewrite /point_on_edge.
   move=> /andP[] /eqP -> _; rewrite lexx /=.
   by move: (on2); rewrite -pp p1l=>/contact_left_slope=>-[].
-have le1ltp1 : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+have le1ltp1 : (left_pt e1).x < p1.x by rewrite p1q.
 have [e1' [le1' re1' sle1']] := sub_edge_left on1 le1ltp1.
 have re1'e2 : right_pt e1' === e2 by rewrite re1' pp.
 rewrite /edge_below.
 set W := (X in X || _); set W' := (X in _ || X).
 have := (contact_right_slope re1'e2); rewrite le1' sle1' => /= -[] eq1 _.
-have p1ltre1 : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+have p1ltre1 : p1.x < (right_pt e1).x by rewrite p1q.
 have [e1'' [le1'' re1'' sle1'']] := sub_edge_right on1 p1ltre1.
 have le1''e2 : left_pt e1'' === e2 by rewrite le1'' pp.
 have /= := (contact_left_slope le1''e2); rewrite re1'' sle1'' => - [] /= eq2 _.
@@ -2365,9 +2368,9 @@ move: (ve2) => /andP[] + _; rewrite le_eqVlt => /orP [/eqP l2p | l2ltp].
   have/contact_left_slope[_ eq3] : left_pt e2 === e1 by rewrite p2l.
   move: on1=>/andP[] /eqP + _; rewrite -p2l => eq4.
   rewrite /W' eq3 lt_neqAle -cmp_slopesNC eq_sym oppr_eq0 -Weq difslope andTb.
-  rewrite /point_strictly_under_edge strictE.
+  rewrite strictE.
   by rewrite -leNgt eq4 lexx -ltNge oppr_lt0.
-have xpp1 : p_x p = p_x p1 by rewrite p1q.
+have xpp1 : p.x = p1.x by rewrite p1q.
 move: on2 l2ltp re2; rewrite -pp xpp1 => on2 l2ltp re2.
 have := intersection_imp_crossing on1 on2 le1ltp1 p1ltre1 l2ltp re2=> -[[]|abs].
   by apply: noc.
@@ -2375,7 +2378,7 @@ by case/negP: difslope; rewrite Weq.
 Qed.
 
 Lemma edge_below_equiv' p (s : pred edge) :
-  {in s, forall e, valid_edge e p && (p_x (left_pt e) < p_x p)} ->
+  {in s, forall e, valid_edge e p && ((left_pt e).x < p.x)} ->
   {in s &, no_crossing} ->
   {in s & , forall e1 e2: edge, (e1 <| e2) = pedge_below' p e1 e2}.
 Proof.
@@ -2386,12 +2389,12 @@ move: (ve1)=> /pvert_on; rewrite -p1q=> on1.
 move=> /[dup] e2in /val /andP[] /[dup] ve2 /exists_point_valid [p2 p2P] le2.
 move: (p2P); rewrite (pvertE ve2) =>/esym[] p2q.
 move: (ve2)=> /pvert_on; rewrite -p2q=> on2; rewrite /pedge_below'.
-have p1p2 : p_x p1 = p_x p2 by rewrite p1q p2q.
+have p1p2 : p1.x = p2.x by rewrite p1q p2q.
 have [vylt /= | vylt' /= | vyq] := ltrgtP.
 - case: (noc e1 e2 e1in e2in) => // abs.
   have := order_below_viz_vertical ve2 ve1 p2P p1P abs; rewrite leNgt.
   by rewrite p1q p2q /= vylt.
-- have le1' : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+- have le1' : (left_pt e1).x < p1.x by rewrite p1q.
   have p2u : p2 <<< e1.
     by rewrite (strict_under_edge_lower_y (esym p1p2)); rewrite // p2q p1q.
   have p1a : p1 >>> e2.
@@ -2410,12 +2413,12 @@ move: (ve1) => /andP[] _ +; rewrite le_eqVlt=>/orP[/eqP pright | pmid] /=.
       apply/eqP; rewrite pt_eqE.
       by rewrite (on_edge_same_point on2 (right_on_edge _)) -pright2 p2q eqxx.
     by apply: same_right_edge_below_slopes; rewrite -p1r pp.
-  have p2ltre2 : p_x p2 < p_x (right_pt e2) by rewrite p2q.
+  have p2ltre2 : p2.x < (right_pt e2).x by rewrite p2q.
   have [e2' [le2' re2' sle2']] := sub_edge_right on2 p2ltre2.
   have le2'e1 : left_pt e2' === e1 by rewrite le2' -pp.
   rewrite /edge_below.
   have := (contact_left_slope le2'e1) => /= -[] _; rewrite re2' sle2' => ->.
-  have le2ltp2 : p_x (left_pt e2) < p_x p2 by rewrite p2q.
+  have le2ltp2 : (left_pt e2).x < p2.x by rewrite p2q.
   have [e2'' [le2'' re2'' sle2'']] := sub_edge_left on2 le2ltp2.
   have re2''e1 : right_pt e2'' === e1 by rewrite re2'' -pp.
   have := (contact_right_slope re2''e1) => -[] _; rewrite le2'' sle2'' => ->.
@@ -2423,17 +2426,17 @@ move: (ve1) => /andP[] _ +; rewrite le_eqVlt=>/orP[/eqP pright | pmid] /=.
   set W := (X in _ || X); have [ | difslope] := boolP W.
     rewrite {}/W=>/le_anti/esym/eqP.
     by rewrite -cmp_slopesNC oppr_eq0 orbT=> /eqP->; rewrite lexx.
-  rewrite orbF -p1r pp {2}/point_under_edge underE.
+  rewrite orbF -p1r pp [p2 <<= _]underE.
    move: (on2); rewrite /point_on_edge.
   move=> /andP[] /eqP -> _; rewrite lexx andbT.
   by move: (on2); rewrite -pp p1r=>/contact_right_slope=>-[].
-have p1ltre1 : p_x p1 < p_x (right_pt e1) by rewrite p1q.
+have p1ltre1 : p1.x < (right_pt e1).x by rewrite p1q.
 have [e1' [le1' re1' sle1']] := sub_edge_right on1 p1ltre1.
 have le1'e2 : left_pt e1' === e2 by rewrite le1' pp.
 rewrite /edge_below.
 set W := (X in X || _); set W' := (X in _ || X).
 have := (contact_left_slope le1'e2); rewrite re1' sle1' => /= -[] eq1 _.
-have le1ltp1 : p_x (left_pt e1) < p_x p1 by rewrite p1q.
+have le1ltp1 : (left_pt e1).x < p1.x by rewrite p1q.
 have [e1'' [le1'' re1'' sle1'']] := sub_edge_left on1 le1ltp1.
 have re1''e2 : right_pt e1'' === e2 by rewrite re1'' pp.
 have /= := (contact_right_slope re1''e2); rewrite le1'' sle1'' => - [] /= eq2 _.
@@ -2451,9 +2454,9 @@ move: (ve2) => /andP[] _; rewrite le_eqVlt => /orP [/eqP r2p | pltr2].
   have/contact_right_slope[_ eq3] : right_pt e2 === e1 by rewrite p2r.
   move: on1=>/andP[] /eqP + _; rewrite -p2r => eq4.
   rewrite /W' eq3 lt_neqAle -cmp_slopesNC oppr_eq0 -Weq difslope andTb.
-  by rewrite /W' /point_strictly_under_edge strictE
+  by rewrite /W' strictE
       eq4 ltxx andbT -ltNge oppr_gt0.
-have xpp1 : p_x p = p_x p1 by rewrite p1q.
+have xpp1 : p.x = p1.x by rewrite p1q.
 move: on2 pltr2 le2; rewrite -pp xpp1 => on2 pltr2 le2.
 have := intersection_imp_crossing on1 on2 le1ltp1 p1ltre1 le2 pltr2=> -[[]|abs].
   by apply: noc.
@@ -2486,18 +2489,18 @@ by move=> s12 s23; rewrite (le_trans s23 s12).
 Qed.
 
 Lemma edge_below_trans p (s : pred edge) :
-  {in s, forall e, p_x p < p_x (right_pt e)} \/ 
-  {in s, forall e, p_x (left_pt e) < p_x p} ->
+  {in s, forall e, p.x < (right_pt e).x} \/ 
+  {in s, forall e, (left_pt e).x < p.x} ->
   {in s, forall e, valid_edge e p} -> {in s &, no_crossing} ->
   {in s & & , transitive edge_below}.
 Proof.
 move=> [rbound | lbound] vals noc e2 e1 e3 e2in e1in e3in.
-  have valb : {in s, forall e, valid_edge e p && (p_x p < p_x (right_pt e))}.
+  have valb : {in s, forall e, valid_edge e p && (p.x < (right_pt e).x)}.
     by move=> e ein; apply/andP; split;[apply: vals | apply: rbound].
   rewrite (edge_below_equiv valb noc) // (edge_below_equiv valb noc) //.
   rewrite (edge_below_equiv valb noc) //.
   by apply: pedge_below_trans.
-have valb : {in s, forall e, valid_edge e p && (p_x (left_pt e) < p_x p)}.
+have valb : {in s, forall e, valid_edge e p && ((left_pt e).x < p.x)}.
   by move=> e ein; apply/andP; split;[apply: vals | apply: lbound].
 rewrite (edge_below_equiv' valb noc) // (edge_below_equiv' valb noc) //.
 rewrite (edge_below_equiv' valb noc) //.
@@ -2507,56 +2510,56 @@ Qed.
 
 Lemma left_pt_above g : left_pt g >>= g.
 Proof.
-rewrite /point_strictly_under_edge strictE.
+rewrite strictE.
 rewrite (eqP (proj1 (area3_two_points _ _))).
 by rewrite ltxx.
 Qed.
 
 Lemma right_pt_above g : right_pt g >>= g.
 Proof.
-rewrite /point_strictly_under_edge strictE.
+rewrite strictE.
 by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) ltxx.
 Qed.
 
 Lemma left_pt_below g : left_pt g <<= g.
 Proof.
-rewrite /point_under_edge underE (eqP (proj1 (area3_two_points _ _))).
+rewrite underE (eqP (proj1 (area3_two_points _ _))).
 by rewrite lexx.
 Qed.
 
 Lemma right_pt_below g : right_pt g <<= g.
 Proof.
-rewrite /point_under_edge underE.
+rewrite underE.
 by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
 Qed.
 
 Lemma under_pvert_y (p : pt) (e : edge) :
-  valid_edge e p -> (p <<= e) = (p_y p <= pvert_y p e).
+  valid_edge e p -> (p <<= e) = (p.y <= pvert_y p e).
 Proof.
 move=> val.
-have xs : p_x p = p_x (Bpt (p_x p) (pvert_y p e)) by [].
-have one : Bpt (p_x p) (pvert_y p e) === e by apply: pvert_on.
+have xs : p.x = (Bpt (p.x) (pvert_y p e)).x by [].
+have one : Bpt (p.x) (pvert_y p e) === e by apply: pvert_on.
 by rewrite (under_edge_lower_y xs one).
 Qed.
 
 Lemma strict_under_pvert_y (p : pt) (e : edge) :
-  valid_edge e p -> (p <<< e) = (p_y p < pvert_y p e).
+  valid_edge e p -> (p <<< e) = (p.y < pvert_y p e).
 Proof.
 move=> val.
-have xs : p_x p = p_x (Bpt (p_x p) (pvert_y p e)) by [].
-have one : Bpt (p_x p) (pvert_y p e) === e by apply: pvert_on.
+have xs : p.x = (Bpt (p.x) (pvert_y p e)).x by [].
+have one : Bpt (p.x) (pvert_y p e) === e by apply: pvert_on.
 by rewrite (strict_under_edge_lower_y xs one).
 Qed.
 
 Lemma same_x_valid (p1 p2 : pt) (g : edge) :
-  p_x p1 == p_x p2 -> valid_edge g p1 = valid_edge g p2.
+  p1.x == p2.x -> valid_edge g p1 = valid_edge g p2.
 Proof.
 by move=> /eqP xs; rewrite /valid_edge/generic_trajectories.valid_edge xs.
 Qed.
 
 Lemma same_pvert_y (p1 p2 : pt) (g : edge) :
   valid_edge g p1 ->
-  p_x p1 == p_x p2 -> pvert_y p1 g = pvert_y p2 g.
+  p1.x == p2.x -> pvert_y p1 g = pvert_y p2 g.
 Proof.
 move=> vg xs; apply/eqP.
 move: (vg) ; rewrite (same_x_valid _ xs) => vg2.
@@ -2596,8 +2599,8 @@ have vg1 : valid_edge g1 p.
   by apply: (allP aval); rewrite !(mem_cat, inE) eqxx ?orbT.
 have vg2 : valid_edge g2 p.
   by apply: (allP aval); rewrite !(mem_cat, inE) eqxx ?orbT.
-have pg1y : pvert_y p g1 <= p_y p by rewrite leNgt -strict_under_pvert_y.
-have pg2y : p_y p < pvert_y p g2 by rewrite -strict_under_pvert_y.
+have pg1y : pvert_y p g1 <= p.y by rewrite leNgt -strict_under_pvert_y.
+have pg2y : p.y < pvert_y p g2 by rewrite -strict_under_pvert_y.
 have g1g2 : pvert_y p g1 < pvert_y p g2 by apply: (le_lt_trans pg1y).
 have mp : {in s1++ g1 :: g2 :: s2 &,
            {homo (pvert_y p) : x y / x <| y >-> x <= y}}.
@@ -2745,8 +2748,8 @@ have aval'' : all (valid_edge^~ r) (le :: s').
 have tr : transitive (relpre (pvert_y r) <=%R).
   by move=> y x z; rewrite /=; apply: le_trans.
 have le_g' : pvert_y r le < pvert_y r g'.
-  have le_r : pvert_y r le < p_y r by rewrite ltNge -under_pvert_y.
-  have r_g' : p_y r <= pvert_y r g' by rewrite -under_pvert_y.
+  have le_r : pvert_y r le < r.y by rewrite ltNge -under_pvert_y.
+  have r_g' : r.y <= pvert_y r g' by rewrite -under_pvert_y.
   by apply: lt_le_trans le_r r_g'.
 have g_le : pvert_y r g <= pvert_y r le.
   move: gin; rewrite mem_rcons inE=> /orP[/eqP -> |gin]; first by rewrite lexx.
@@ -2793,8 +2796,8 @@ have aval'' : all (valid_edge^~ r) (he :: s').
 have tr : transitive (relpre (pvert_y r) <=%R).
   by move=> y x z; rewrite /=; apply: le_trans.
 have g_he : pvert_y r g < pvert_y r he.
-  have r_he : p_y r < pvert_y r he by rewrite -strict_under_pvert_y.
-  have g_r : pvert_y r g <= p_y r by rewrite leNgt -strict_under_pvert_y.
+  have r_he : r.y < pvert_y r he by rewrite -strict_under_pvert_y.
+  have g_r : pvert_y r g <= r.y by rewrite leNgt -strict_under_pvert_y.
   by apply: le_lt_trans g_r r_he.
 have he_g' : pvert_y r he <= pvert_y r g'.
   move: pth; rewrite cat_path last_rcons => /andP[] _.

From 6e4a54f96e9eed783323d4ae848742f72b907fd2 Mon Sep 17 00:00:00 2001
From: Reynald Affeldt <reynald.affeldt@aist.go.jp>
Date: Fri, 26 Apr 2024 11:03:22 +0900
Subject: [PATCH 25/43] bool -> Prop

---
 theories/cells.v            |  23 +-
 theories/cells_alg.v        |  96 ++--
 theories/opening_cells.v    |  19 +-
 theories/points_and_edges.v | 871 ++++++++++++++++--------------------
 theories/safe_cells.v       |  23 +-
 5 files changed, 449 insertions(+), 583 deletions(-)

diff --git a/theories/cells.v b/theories/cells.v
index 54b3cfe..5cd8421 100644
--- a/theories/cells.v
+++ b/theories/cells.v
@@ -124,7 +124,7 @@ Lemma inside_open'E p c :
    p_x p <= open_limit c].
 Proof.
 rewrite /inside_open' /inside_open_cell contains_pointE.
-rewrite /point_strictly_under_edge strictE -leNgt !le_eqVlt.
+rewrite strictE -leNgt !le_eqVlt.
 rewrite [in _ >>> low c]/point_under_edge -ltNge subrr.
 by case: (0 < _); case: (_ < p_x p); rewrite ?andbF ?orbT ?andbT.
 Qed.
@@ -141,7 +141,6 @@ Lemma inside_closed'E p c :
      p_x p <= right_limit c].
 Proof.
 rewrite /inside_closed' /inside_closed_cell contains_pointE.
-rewrite /point_strictly_under_edge.
 rewrite strictE -leNgt !le_eqVlt.
 rewrite [in _ >>> low c]/point_under_edge -ltNge subrr.
 by case: (0 < _); case: (_ < p_x p); rewrite ?andbF ?orbT ?andbT.
@@ -374,15 +373,14 @@ Proof.
 rewrite contains_pointE /event_close_edge .
 move =>  rf val [/eqP rlc | /eqP rhc].
 move : rf val.
-  rewrite /point_strictly_under_edge !strictE -rlc {rlc e}.
-  have := (area3_two_points (right_pt (low c)) (left_pt (low c))) => [][] _ [] /eqP -> _ .
-  rewrite lt_irreflexive /=.
-  rewrite /edge_below.
+  rewrite !strictE -rlc {rlc e}.
+  have := area3_two_points (right_pt (low c)) (left_pt (low c)) => [][] _ [] -> _.
+  rewrite ltxx /= /edge_below.
   move => /orP [] /andP [] //= => pablhlow pabrhlow [] _ validrlhigh.
   apply: not_strictly_above pablhlow pabrhlow validrlhigh.
   move : rf val.
-rewrite /point_under_edge underE -rhc {rhc}.
-have := (area3_two_points (right_pt (high c)) (left_pt (high c))) => [] [] _ [] /eqP -> _ /=.
+rewrite underE -rhc {rhc}.
+have := area3_two_points (right_pt (high c)) (left_pt (high c)) => [] [] _ [] -> _ /=.
 rewrite le_refl /edge_below /= andbT=> /orP [] /andP [] //= => pablhlow pabrhlow [] valrhlow _ .
 apply : not_strictly_under pablhlow pabrhlow valrhlow.
 Qed.
@@ -430,18 +428,19 @@ set e2 := @Bedge R (Bpt 0 2) (Bpt 1 1) ltr01.
 set p := (Bpt 3%:R 0).
 set c := Bcell [::] [::] e1 e2.
 have exrf : s_right_form [:: c].
-  rewrite /= /= /e1 /e2 /edge_below /= /point_under_edge !underE /=.
-  rewrite /point_strictly_under_edge  !strictE /=.
+  rewrite /= andbT /e1 /e2 /edge_below /=.
+  rewrite /generic_trajectories.point_under_edge !underE /=.
+  rewrite /generic_trajectories.point_under_edge !strictE /=.
   rewrite !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK, addrK).
   rewrite le_refl lt_irreflexive /= !andbT.
   rewrite -[X in X - 2%:R]/(1%:R) -opprB -natrB //  -[(2-1)%N]/1%N.
   by rewrite lerN10.
 have plow : p <<< low (head dummy_cell [:: c]).
-  rewrite /point_strictly_under_edge strictE /=.
+  rewrite strictE /=.
   by rewrite !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK) ltrN10.
 have := abs [::c] p isT isT exrf  plow c.
 rewrite inE=> /(_ (eqxx _))=> [][] _.
-rewrite /point_strictly_under_edge strictE /=.
+rewrite strictE /=.
 rewrite
   !(mul0r, subrr, mul1r, subr0, add0r, addr0, oppr0, opprK, mulr1, addrK).
 rewrite -natrM -!natrB // -[X in X%:R]/(1%N).
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index 031ce72..ed9680c 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -1840,14 +1840,14 @@ case lptsq : (left_pts lsto) => [ | p1 [ | p2 lpts]] //.
   by move: lstok; rewrite /open_cell_side_limit_ok lptsq.
 have /andP[p1onh p1onl] : (p1 === high lsto) && (p1 === low lsto).
   by move: lstok; rewrite /open_cell_side_limit_ok /left_limit lptsq /= eqxx /=.
-have /eqP samex : p_x (point e) = p_x p1.
+have samex : p_x (point e) = p_x p1.
   by have := pxhere; rewrite lstxq /left_limit lptsq /=.
 suff : p_y (point e) < p_y (point e) by rewrite lt_irreflexive.
-have := same_pvert_y vho samex. 
-rewrite (on_pvert p1onh). 
+have := same_pvert_y vho samex.
+rewrite (on_pvert p1onh).
 have := under_pvert_y vho; move: (puh)=> /[swap] -> /[swap] ->.
 move=> /le_lt_trans; apply.
-have := under_pvert_y vlo; move: (pal) => /[swap] ->.  
+have := under_pvert_y vlo; move: (pal) => /[swap] ->.
 rewrite (same_pvert_y vlo samex).
 by rewrite -ltNge (on_pvert p1onl).
 Qed.
@@ -1973,13 +1973,13 @@ move=> /andP[] /andP[] /[dup] /eqP p1x -> /andP[] -> ->.
 move=> /andP[] /andP[] -> -> /andP[] p1on ->.
 rewrite /= !andbT.
 have p1e : p1 = (point e).
-  have /eqP samex : p_x (point e) = p_x p1.
+  have samex : p_x (point e) = p_x p1.
     by have := pxhere; rewrite lstxq /left_limit lptsq /= p1x.
-  have /eqP samey : p_y (point e) = p_y p1.
+  have samey : p_y (point e) = p_y p1.
     have eonlsthe' : point e === high lsto.
       by apply: under_above_on=> //; rewrite -lstheq // ?underW.
-    by have /eqP := on_edge_same_point eonlsthe' p1on samex.
-  by apply/esym/(@eqP pt); rewrite pt_eqE samex samey.
+    exact: (on_edge_same_point eonlsthe' p1on samex).
+  by apply/esym/(@eqP pt); rewrite pt_eqE samex samey !eqxx.
 rewrite p1e /generic_trajectories.pvert_y subrr -strict_under_pvert_y //.
 by rewrite puh -pxe pvert_on.
 Qed.
@@ -2385,7 +2385,7 @@ Lemma lexPt_left_pt_strict_under_edge_to_p_x (pt : pt) g:
   p_x (left_pt g) < p_x pt.
 Proof.
 move=> vg.
-rewrite /lexPt eq_sym=> /orP[ | /andP[] samex]; first by [].
+rewrite /lexPt eq_sym=> /orP[ | /andP[] /eqP samex]; first by [].
 have := same_pvert_y vg samex.
 rewrite (on_pvert (left_on_edge g))=> <-.
 rewrite ltNge le_eqVlt negb_or andbC.
@@ -2493,7 +2493,7 @@ rewrite inE => /orP[/eqP -> | ].
     have [_ /= ] := adjacent_opening_aux vle vhe oute3 oca_eq => ->.
     rewrite /=.
     move=> /on_edge_same_point /[apply] /=.
-    rewrite xcond /left_limit lptsq /= eqxx => /(_ isT) /eqP ->.
+    rewrite xcond /left_limit lptsq /= => /(_ erefl) ->.
     by apply/(@eqP pt); rewrite pt_eqE /= !eqxx.
   by [].
 move=> c1in; exists c1; first by rewrite inE c1in orbT.
@@ -3821,7 +3821,7 @@ have vhe : valid_edge lsthe (point e).
   move: (allP sval lsto); rewrite /open mem_cat inE eqxx !orbT.
   by move=> /(_ isT)=> /andP[]; rewrite lstheq.
 move: puh; rewrite under_pvert_y //.
-move: (samex)=> /esym/eqP=> samex'.
+move: (samex)=> /esym samex'.
 rewrite (same_pvert_y vhe samex').
 by rewrite (on_pvert (left_on_edge _)) leNgt lty.
 Qed.
@@ -4390,13 +4390,13 @@ have [yle | yabove] := lerP (p_y pt') (p_y (point e)).
       by apply: valid_edge_extremities; rewrite (oute lco).
     move: pin => /andP[] + _; rewrite under_pvert_y; last first.
       by move: vlce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
-    rewrite -(same_pvert_y vlce); last by apply/eqP.
+    rewrite -(same_pvert_y vlce)//.
     by rewrite on_pvert ?yle // -(eqP (oute lco)) // left_on_edge.
   have plec : contains_point' pt' lec.
     rewrite /contains_point' -leq pale.
     rewrite under_pvert_y //.
     apply: (le_trans yle).
-    rewrite -(same_pvert_y vhlece); last by apply/eqP.
+    rewrite -(same_pvert_y vhlece)//.
     rewrite -under_pvert_y //.
     case ccq': cc => [ | cc0 ccs].
       by move: ccq; rewrite ccq' /= => -[] <- _; rewrite -heq; apply/underW.
@@ -4443,8 +4443,7 @@ have plcc : contains_point' pt' lcc.
       by apply: valid_edge_extremities; rewrite (oute hco).
     move: (pin) => /andP[] _; rewrite under_pvert_y; last first.
       by move: vhce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
-    rewrite -(same_pvert_y vhce); last by apply/eqP.
-    rewrite on_pvert; last first.
+    rewrite -(same_pvert_y vhce)// on_pvert; last first.
       by rewrite -(eqP (oute hco)) // left_on_edge.
     move=> ple.
     have ppe': p_y pt' = p_y (point e).
@@ -4457,9 +4456,8 @@ have plcc : contains_point' pt' lcc.
   have vllccp : valid_edge (low lcc) pt'.
     by move: vllcce; rewrite /valid_edge/generic_trajectories.valid_edge ppe.
   rewrite under_pvert_y // -?ltNge.
-  apply: le_lt_trans yabove.  
-  rewrite -(same_pvert_y vllcce); last by apply/eqP.
-  rewrite leNgt -strict_under_pvert_y //.
+  apply: le_lt_trans yabove.
+  rewrite -(same_pvert_y vllcce)// leNgt -strict_under_pvert_y //.
   by have /andP[] := lcc_ctn.
 have [/eqP lbnd' | safe] := boolP(left_limit lcc == p_x pt').
   rewrite closeeq has_cat /= orbA.
@@ -4761,7 +4759,7 @@ have /andP [vlcc vhcc] : valid_edge (low lcc) (point e) &&
 have := right_limit_close_cell vlcc vhcc.
 rewrite /in_safe_side_right.
 move=> ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have [-> -> _] := close_cell_preserve_3sides (point e) lcc.
 rewrite -heq.
 have eonllcc : (point e) === low lcc.
@@ -4772,10 +4770,8 @@ have eonllcc : (point e) === low lcc.
   move=> + /(_ cc2) =>/[swap] /[apply].
   move: adj; rewrite ocd ccq cat_rcons; do 2 move =>/adjacent_catW[] _.
   by move=> /= /andP[] /eqP ->.
-have vppl : valid_edge (low lcc) pp.
-  by rewrite (same_x_valid _ samex).
-have vpphe : valid_edge he pp.
-  by rewrite (same_x_valid _ samex).
+have vppl : valid_edge (low lcc) pp by rewrite (same_x_valid _ samex).
+have vpphe : valid_edge he pp by rewrite (same_x_valid _ samex).
 rewrite (under_pvert_y vppl) (same_pvert_y vppl samex) -ltNge.
 rewrite (on_pvert eonllcc).
 rewrite (andbC _ (pp <<< he)).
@@ -4813,17 +4809,15 @@ have /andP [vlcc1 vhcc1] : valid_edge (low cc1) (point e) &&
 have := right_limit_close_cell vlcc1 vhcc1.
 rewrite /in_safe_side_right.
 move=> ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have [-> -> _] := close_cell_preserve_3sides (point e) cc1.
 rewrite -leq.
 have eonhcc1 : (point e) === high cc1.
   have := open_cells_decomposition_point_on cbtom adj
             (inside_box_between inbox_e) sval oe.
   by move=> /(_ cc1 (mem_head _ _)).
-have vpph : valid_edge (high cc1) pp.
-  by rewrite (same_x_valid _ samex).
-have vpple : valid_edge le pp.
-  by rewrite (same_x_valid _ samex).
+have vpph : valid_edge (high cc1) pp by rewrite (same_x_valid _ samex).
+have vpple : valid_edge le pp by rewrite (same_x_valid _ samex).
 rewrite (strict_under_pvert_y vpph) (same_pvert_y vpph samex).
 rewrite (on_pvert eonhcc1).
 have [ppue /= | ] := boolP (p_y pp < p_y (point e)); last by [].
@@ -4868,11 +4862,9 @@ have eonl : point e === low c'.
   by apply: allon; rewrite ccq -cat_cons mem_cat mem_last.
 rewrite /in_safe_side_right cq=> ->.
 have [-> -> _] := close_cell_preserve_3sides (point e) c'.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
-have vpph : valid_edge (high c') pp.
-  by rewrite (same_x_valid _ samex).
-have vppl : valid_edge (low c') pp.
-  by rewrite (same_x_valid _ samex).
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have vpph : valid_edge (high c') pp by rewrite (same_x_valid _ samex).
+have vppl : valid_edge (low c') pp by rewrite (same_x_valid _ samex).
 rewrite (strict_under_pvert_y vpph) (same_pvert_y vpph samex).
 rewrite (on_pvert eonh).
 rewrite (under_pvert_y vppl) (same_pvert_y vppl samex).
@@ -4914,7 +4906,7 @@ have [ppe | ppne] := eqVneq (pp : pt) (point e).
 have := right_limit_close_cell vllcc vhlcc.
 rewrite /in_safe_side_right.
 move=> ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have [-> -> _] := close_cell_preserve_3sides (point e) lcc.
 rewrite -heq -leq.
 have puhy : p_y (point e) < pvert_y (point e) he.
@@ -4942,9 +4934,9 @@ have [pu | ] := ltrP (p_y pp) (p_y (point e)).
     apply/negbTE; move: (ppuhe).
     rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
     by rewrite (same_pvert_y vpphe samex).
-  by rewrite ppaly ppuhy ppuhe.
+  by rewrite ppaly ppuhy ppuhe !eqxx.
 rewrite le_eqVlt => /orP[samey | /[dup] pa ->].
-   by case/negP: ppne; rewrite pt_eqE samex eq_sym samey.
+   by case/negP: ppne; rewrite pt_eqE samex eq_sym samey !eqxx.
 rewrite andbF andbT /=.
 have [ppuhe /= | ] := boolP (pp <<< he); last by [].
 
@@ -4961,7 +4953,7 @@ have ppuhy : (p_y pp == pvert_y (point e) he) = false.
   apply/negbTE; move: (ppuhe).
   rewrite (strict_under_pvert_y vpphe) lt_neqAle=> /andP[] + _.
   by rewrite (same_pvert_y vpphe samex).
-by rewrite ppale ppuhy ppaly.
+by rewrite ppale ppuhy ppaly !eqxx.
 Qed.
 
 Lemma sides_equiv fc cc lcc lc le he:
@@ -6115,10 +6107,9 @@ have safe_cl : {in events_to_edges [:: ev] & [:: close_cell (point ev) op0],
   rewrite right_limit_close_cell // => /eqP samex.
   move/negP;apply.
   suff -> : p = point ev by rewrite close_cell_in.
-  apply /(@eqP pt); rewrite pt_eqE samex eqxx.
-  apply: (on_edge_same_point pong).
-    by rewrite -lgq left_on_edge.
-  by apply/eqP.
+  apply/eqP; rewrite pt_eqE samex eqxx/=; apply/eqP.
+  apply: (on_edge_same_point pong) => //.
+  by rewrite -lgq left_on_edge.
 have safe_op : {in events_to_edges [:: ev] & nos ++ [:: lno],
           forall g c p, in_safe_side_left p c -> ~ p === g}.
   move=> g c gin cin p pin pong.
@@ -6130,12 +6121,12 @@ have safe_op : {in events_to_edges [:: ev] & nos ++ [:: lno],
   move: pin=> /andP[] + /andP[] _ /andP[] _.
   have := opening_cells_left oute vb0 vt0.
   have := opening_cells_in vb0 vt0 oute.
-  rewrite /opening_cells oca_eq=> /(_ _ cin) evin /(_ _ cin) -> samex.
+  rewrite /opening_cells oca_eq=> /(_ _ cin) evin /(_ _ cin) -> /eqP samex.
   move/negP; apply.
   suff -> : p = point ev.
     by apply: (opening_cells_in vb0 vt0 oute); rewrite /opening_cells oca_eq.
-  apply/(@eqP pt); rewrite pt_eqE samex /=.
-  by apply: (on_edge_same_point pong eong samex).
+  apply/eqP; rewrite pt_eqE samex eqxx/=; apply/eqP.
+  apply: (on_edge_same_point pong eong samex) => //.
 have cl_no_event : {in [:: ev] & [:: close_cell (point ev) op0],
   forall e c (p : pt), in_safe_side_left p c || in_safe_side_right p c ->
        p != point e}.
@@ -6515,13 +6506,13 @@ have cl_safe_edge :
     move=> /oute /eqP lgq /andP[] _ /andP[]; rewrite lgq leNgt=> /negP[].
     by rewrite (eqP pl); apply: lolt; rewrite // inE eqxx.
   have vc' : valid_cell c' (point ev) by apply/andP/(allP sval).
-  have samex : p_x p == p_x (point ev).
+  have /eqP samex : p_x p == p_x (point ev).
     by move: pin=> /andP[] + _; rewrite close_cell_right_limit.
   move: gin; rewrite mem_cat=> /orP[gin | /oute/eqP lgq ]; last first.
     have peg : point ev === g by rewrite -lgq left_on_edge.
     move=> pong.
-    have samey := on_edge_same_point pong peg samex.
-    have pev : p = point ev by apply/eqP; rewrite pt_eqE samex samey.
+    have /eqP samey := on_edge_same_point pong peg samex.
+    have pev : p = point ev by apply/eqP; rewrite pt_eqE samex samey eqxx.
     have := not_safe_event (close_cell (point ev) c').
     rewrite -[e in in_safe_side_right e _]pev pin orbT.
     by rewrite /closing_cells -map_rcons map_f // => /(_ isT).
@@ -6530,8 +6521,7 @@ have cl_safe_edge :
     move=> [[ | pcc0 pcc] []]; first by []. 
     move=> _ /= [pccsub [pcchigh [_ [_ rlpcc]]]] /andP[] _ /andP[] _.
     rewrite leNgt=> /negP; apply.
-    rewrite (eqP samex).
-    rewrite -rlpcc; apply:rl; last by rewrite inE eqxx.
+    rewrite samex -rlpcc; apply:rl; last by rewrite inE eqxx.
     by apply/pccsub; rewrite /last_cell /= mem_last.
   move=> [] opc [] pcc [] _ [] opch [] _ [] opco _ abs.
   have [vlc'p vhc'p] : valid_edge (low c') p /\ valid_edge (high c') p.
@@ -6563,9 +6553,9 @@ have cl_safe_edge :
     move=> /(_ p) + ; move=>/negP.
     rewrite inside_open'E stricter valid_open_limit //.
     move: cnt; rewrite contains_pointE=> /andP[] _ ->.
-    rewrite (eqP samex) lolt //=; last by rewrite inE eqxx.
+    rewrite samex lolt //=; last by rewrite inE eqxx.
     rewrite inside_open'E (underW puhc') palc' valid_open_limit //.
-    by rewrite (eqP samex) lolt // inE eqxx.
+    by rewrite samex lolt // inE eqxx.
   move=> ponl.
   have vbp : valid_edge bottom p.
     by rewrite (same_x_valid _ samex) (inside_box_valid_bottom inbox_e).
@@ -6597,7 +6587,7 @@ have cl_safe_edge :
   have opcok : open_cell_side_limit_ok opc by apply: (allP (sides_ok c_inv)).
   move=> /(_ _ ponl ponh); rewrite !inE=> /orP[/eqP pleft | /eqP].
     have : left_limit opc < p_x p.
-      by rewrite (eqP samex); apply: lolt; rewrite // inE eqxx.
+      by rewrite samex; apply: lolt; rewrite // inE eqxx.
     have := left_limit_max opcok.
     have [_ | ] := lerP (p_x (left_pt (high opc)))(p_x (left_pt (low opc))).
       by move=> /le_lt_trans /[apply]; rewrite pleft lt_irreflexive.
@@ -6631,7 +6621,7 @@ have cl_safe_edge :
     have /andP[_ /=]:= general_pos c_inv.
   rewrite path_sortedE; last by move=> ? ? ?; apply: lt_trans.
   move=> /andP[] /allP /(_ e2 e2in).
-  by rewrite -pe2 -prl (eqP samex) lt_irreflexive.
+  by rewrite -pe2 -prl samex ltxx.
 have op_safe_edge :
   {in events_to_edges (rcons p_set ev) & state_open_seq rstate,
     forall g c p, in_safe_side_left p c -> ~ p === g}.
diff --git a/theories/opening_cells.v b/theories/opening_cells.v
index 9064180..fb4f971 100644
--- a/theories/opening_cells.v
+++ b/theories/opening_cells.v
@@ -961,7 +961,7 @@ have lnoin : lno \in opening_cells (point e) (outgoing e) le he.
   by rewrite oeq mem_rcons mem_head.
 rewrite /in_safe_side_left.
 have := opening_cells_left oute vle vhe lnoin=> ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have highlno : high lno = he.
   by have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq.
 rewrite highlno [in RHS]andbC.
@@ -985,7 +985,7 @@ have /oute lfnoq : high (last fno nos') \in outgoing e.
 rewrite ?mem_head // last_rcons inE map_rcons mem_rcons mem_head orbT.
 have eonl : point e === low lno by rewrite llnoq -(eqP lfnoq) left_on_edge.
 have ppal : (pp >>> low lno) = (p_y (point e) < p_y pp).
-  have := under_edge_lower_y (eqP samex) eonl => ->.
+  have := under_edge_lower_y samex eonl => ->.
   by rewrite -ltNge.
 rewrite ppal.
 have := opening_cells_last_left_pts vle vhe oute ogn0 puh.
@@ -1024,7 +1024,7 @@ rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
 case: ifP=> // samept.
 have := pvert_on vle; rewrite -(eqP samept) => onle.
 have /andP[/eqP pf _] := onle.
-by move: pal; rewrite /point_under_edge underE pf le_eqVlt eqxx.
+by move: pal; rewrite underE pf le_eqVlt eqxx.
 Qed.
 
 Lemma first_opening_cells_side_char e le he pp fno nos lno :
@@ -1048,7 +1048,7 @@ have fnoin : fno \in opening_cells (point e) (outgoing e) le he.
   by rewrite oeq mem_rcons !inE eqxx orbT.
 rewrite /in_safe_side_left.
 have := opening_cells_left oute vle vhe fnoin=> ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 have lowfno : low fno = le.
   by rewrite (lower_edge_new_cells vle vhe oeq).
 rewrite lowfno.
@@ -1063,7 +1063,7 @@ have /oute hfnoq : high fno \in outgoing e.
   by rewrite mem_head.
 have eonh : point e === high fno by rewrite -(eqP hfnoq) left_on_edge.
 have ppue : (pp <<< high fno) = (p_y pp < p_y (point e)).
-  by have := strict_under_edge_lower_y (eqP samex) eonh.
+  by have := strict_under_edge_lower_y samex eonh.
 rewrite ppue.
 have := opening_cells_first_left_pts he vle ogn0 pal.
 rewrite oca_eq /= => ->.
@@ -1147,7 +1147,7 @@ rewrite (pvertE vle) (pvertE vhe) /= orbF.
 set c := Bcell _ _ _ _.
 move=> /(_ _ (mem_head _ _)).
 rewrite /in_safe_side_left /= => ->.
-have [samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
+have [/eqP samex /= | ] := boolP (p_x pp == p_x (point e)); last by [].
 rewrite andbCA.
 have puhy : p_y (point e) < pvert_y (point e) he.
   by rewrite -(strict_under_pvert_y vhe).
@@ -1161,8 +1161,8 @@ have vpple : valid_edge le pp by rewrite (same_x_valid _ samex).
 have vpphe : valid_edge he pp by rewrite (same_x_valid _ samex).
 
 have [ | pa] := lerP (p_y pp) (p_y (point e)); rewrite ?(andbF, orbF).
-  rewrite le_eqVlt => /orP[samey | /[dup] pu ->].
-    by case/negP: ppne; rewrite pt_eqE samex samey.
+  rewrite le_eqVlt => /orP[/eqP samey | /[dup] pu ->].
+    by case/negP: ppne; rewrite pt_eqE samex samey !eqxx.
   have [ppale | _] := boolP (pp >>> le); last by [].
   have -> : pp <<< he.
     rewrite (strict_under_pvert_y vpphe).
@@ -1248,7 +1248,7 @@ Lemma half_between_edges (g1 g2 : edge) p :
   (Bpt (p_x p) ((pvert_y p g1 + pvert_y p g2) / 2)) <<< g2.
 Proof.
 move=> vg1 vg2 pal puh; set p1 := Bpt _ _.
-have samex : p_x p1 == p_x p by rewrite eqxx.
+have samex : p_x p1 = p_x p by [].
 have v1g1 : valid_edge g1 p1 by rewrite (same_x_valid _ samex).
 have v1g2 : valid_edge g2 p1 by rewrite (same_x_valid _ samex).
 rewrite (under_pvert_y v1g1) (strict_under_pvert_y v1g2) -ltNge; apply/andP.
@@ -1392,4 +1392,3 @@ End opening_cells.
 End proof_environment.
 
 End working_environment.
-
diff --git a/theories/points_and_edges.v b/theories/points_and_edges.v
index 86f3e1b..1c19412 100644
--- a/theories/points_and_edges.v
+++ b/theories/points_and_edges.v
@@ -28,8 +28,8 @@ Lemma pt_eqP : Equality.axiom (pt_eqb R eq_op).
 Proof.
 rewrite /Equality.axiom.
 move=> [a_x a_y] [b_x b_y]; rewrite /pt_eqb/=.
-have [/eqP <-|/eqP anb] := boolP(a_x == b_x).
-  have [/eqP <- | /eqP anb] := boolP(a_y == b_y).
+have [/eqP <-|/eqP anb] := boolP (a_x == b_x).
+  have [/eqP <- | /eqP anb] := boolP (a_y == b_y).
     by apply: ReflectT.
   by apply : ReflectF => [][].
 by apply: ReflectF=> [][].
@@ -37,8 +37,7 @@ Qed.
 
 HB.instance Definition _ := hasDecEq.Build _ pt_eqP.
 
-Lemma pt_eqE (p1 p2 : pt) :
-   (p1 == p2) = (p1.x == p2.x) && (p1.y == p2.y).
+Lemma pt_eqE (p1 p2 : pt) : (p1 == p2) = (p1.x == p2.x) && (p1.y == p2.y).
 Proof. by move: p1 p2 => [? ?][? ?]. Qed.
 
 Record edge := Bedge {left_pt : pt; right_pt : pt;
@@ -55,8 +54,8 @@ Proof.  by move: e => [l r c]. Qed.
 Lemma edge_eqP : Equality.axiom edge_eqb.
 Proof.
 move=> [a1 b1 p1] [a2 b2 p2] /=.
-have [/eqP a1a2 | /eqP a1na2] := boolP(a1 == a2).
-  have [/eqP b1b2 | /eqP b1nb2] := boolP(b1 == b2).
+have [/eqP a1a2 | /eqP a1na2] := boolP (a1 == a2).
+  have [/eqP b1b2 | /eqP b1nb2] := boolP (b1 == b2).
      move: p1 p2. rewrite -a1a2 -b1b2 => p1 p2.
      rewrite (eqtype.bool_irrelevance p1 p2).
      by apply: ReflectT.
@@ -175,7 +174,8 @@ Proof.
   mc_ring.
 Qed.
 
-Lemma pue_f_inter p_x  a_x a_y b_x b_y :  b_x != a_x -> (pue_f p_x ((p_x - a_x)* ((b_y - a_y)/(b_x - a_x)) + a_y) a_x a_y b_x b_y) == 0.
+Lemma pue_f_inter p_x  a_x a_y b_x b_y : b_x != a_x ->
+  pue_f p_x ((p_x - a_x)* ((b_y - a_y)/(b_x - a_x)) + a_y) a_x a_y b_x b_y = 0.
 Proof.
 rewrite /pue_f.
 rewrite -subr_eq0 => h.
@@ -183,17 +183,18 @@ set slope := (_ / _).
 
 rewrite (mulrDr b_x).
 rewrite (mulrDr a_x).
-rewrite -(orbF (_==0)).
-rewrite -(negbTE   h).
+apply/eqP.
+rewrite -(orbF (_ == 0)).
+rewrite -(negbTE h).
 rewrite -mulf_eq0 .
-rewrite ! ( mulrBl (b_x - a_x), fun x y => mulrDl  x y (b_x - a_x)).
+rewrite ! ( mulrBl (b_x - a_x), fun x y => mulrDl x y (b_x - a_x)).
 
 rewrite /slope !mulrA !mulfVK //.
 apply/eqP; mc_ring.
 Qed.
 
 Lemma pue_f_inters p_x p_y a_x a_y b_x b_y  :  b_x != a_x -> p_y = ((p_x - a_x) * ((b_y - a_y) / (b_x - a_x)) + a_y) ->
-pue_f p_x p_y a_x a_y b_x b_y == 0.
+pue_f p_x p_y a_x a_y b_x b_y = 0.
 Proof.
 move => h ->.
 by apply pue_f_inter; rewrite h.
@@ -201,46 +202,30 @@ by apply pue_f_inter; rewrite h.
 
 Qed.
 
-Lemma pue_f_eq p_x p_y a_x a_y :
-pue_f p_x p_y p_x p_y a_x a_y == 0.
-Proof.
-rewrite /pue_f /=.
-
-apply /eqP.
-mc_ring.
-Qed.
+Lemma pue_f_eq p_x p_y a_x a_y : pue_f p_x p_y p_x p_y a_x a_y = 0.
+Proof. by rewrite /pue_f /=; mc_ring. Qed.
 
 Lemma pue_f_two_points p_x p_y a_x a_y :
-pue_f p_x p_y p_x p_y a_x a_y == 0 /\ pue_f p_x p_y a_x a_y p_x p_y == 0 /\
-pue_f p_x p_y a_x a_y a_x a_y == 0.
+  pue_f p_x p_y p_x p_y a_x a_y = 0 /\
+  pue_f p_x p_y a_x a_y p_x p_y = 0 /\
+  pue_f p_x p_y a_x a_y a_x a_y = 0.
 Proof.
 split.
-apply pue_f_eq.
+  by rewrite pue_f_eq.
 split.
-have := pue_f_c p_x p_y  a_x a_y p_x p_y.
-move => ->.
-apply pue_f_eq.
-have := pue_f_c  a_x a_y  a_x a_y p_x p_y.
-move => <-.
-apply pue_f_eq.
+  by rewrite (pue_f_c p_x p_y  a_x a_y p_x p_y) pue_f_eq.
+by rewrite -(pue_f_c  a_x a_y  a_x a_y p_x p_y) pue_f_eq.
 Qed.
 
 Lemma pue_f_vert p_y a_x a_y b_x b_y :
- (pue_f a_x a_y b_x b_y b_x p_y) == (b_x - a_x) * (p_y - b_y).
-Proof.
-rewrite /pue_f.
-apply /eqP.
-mc_ring.
-Qed.
+ pue_f a_x a_y b_x b_y b_x p_y = (b_x - a_x) * (p_y - b_y).
+Proof. by rewrite /pue_f; mc_ring. Qed.
 
 Lemma ax4 p_x p_y q_x q_y r_x r_y t_x t_y :
-pue_f t_x t_y q_x q_y r_x r_y + pue_f p_x p_y t_x t_y r_x r_y
-+ pue_f p_x p_y q_x q_y t_x t_y == pue_f p_x p_y q_x q_y r_x r_y.
-Proof.
-rewrite /pue_f.
-apply /eqP.
-  mc_ring.
-Qed.
+  pue_f t_x t_y q_x q_y r_x r_y +
+  pue_f p_x p_y t_x t_y r_x r_y +
+  pue_f p_x p_y q_x q_y t_x t_y = pue_f p_x p_y q_x q_y r_x r_y.
+Proof. by rewrite /pue_f; mc_ring. Qed.
 
 Lemma pue_f_linear l a b c d e f :
 l * pue_f a b c d e f = pue_f a (l*b) c (l*d) e (l*f).
@@ -250,64 +235,58 @@ mc_ring.
 Qed.
 
 Lemma pue_f_on_edge_y a_x a_y b_x b_y m_x m_y :
-pue_f m_x m_y a_x a_y b_x b_y == 0 ->
-(b_x - a_x) * m_y = m_x * (b_y -a_y)- (a_x * b_y - b_x *a_y).
-Proof.
-move => /eqP abmeq0.
-apply /eqP.
-rewrite -subr_eq0.
-apply /eqP.
-rewrite -abmeq0 /pue_f.
-mc_ring.
+  pue_f m_x m_y a_x a_y b_x b_y = 0 ->
+  (b_x - a_x) * m_y = m_x * (b_y -a_y)- (a_x * b_y - b_x *a_y).
+Proof.
+move=> abmeq0.
+apply/eqP; rewrite -subr_eq0; apply/eqP.
+by rewrite -abmeq0 /pue_f; mc_ring.
 Qed.
 
 Lemma pue_f_on_edge a_x a_y b_x b_y c_x c_y d_x d_y m_x m_y :
-pue_f m_x m_y a_x a_y b_x b_y == 0 ->
-(b_x - a_x) * pue_f m_x m_y c_x c_y d_x d_y ==
-(m_x - a_x) * pue_f b_x b_y c_x c_y d_x d_y + (b_x - m_x) * pue_f a_x a_y c_x c_y d_x d_y.
+  pue_f m_x m_y a_x a_y b_x b_y = 0 ->
+  (b_x - a_x) * pue_f m_x m_y c_x c_y d_x d_y =
+  (m_x - a_x) * pue_f b_x b_y c_x c_y d_x d_y +
+  (b_x - m_x) * pue_f a_x a_y c_x c_y d_x d_y.
 Proof.
-move => on_ed.
-rewrite pue_f_linear  /pue_f (pue_f_on_edge_y on_ed).
-apply /eqP.
+move=> on_ed.
+rewrite pue_f_linear /pue_f (pue_f_on_edge_y on_ed).
 mc_ring.
 Qed.
 
 Lemma pue_f_triangle_on_edge a_x a_y b_x b_y p_x p_y p'_x p'_y :
-pue_f p'_x p'_y a_x a_y b_x b_y == 0 ->
-(b_x - a_x) * pue_f p'_x p'_y a_x a_y p_x p_y ==
-(p'_x - a_x) * pue_f b_x b_y a_x a_y p_x p_y .
+  pue_f p'_x p'_y a_x a_y b_x b_y = 0 ->
+  (b_x - a_x) * pue_f p'_x p'_y a_x a_y p_x p_y =
+  (p'_x - a_x) * pue_f b_x b_y a_x a_y p_x p_y .
 Proof.
 move=> on_ed.
-rewrite pue_f_linear  /pue_f (pue_f_on_edge_y on_ed).
-apply /eqP.
+rewrite pue_f_linear /pue_f (pue_f_on_edge_y on_ed).
 mc_ring.
 Qed.
 
 Lemma pue_f_triangle_on_edge' a_x a_y b_x b_y p_x p_y p'_x p'_y :
-pue_f p'_x p'_y a_x a_y b_x b_y == 0 ->
-(b_x - a_x) * pue_f p'_x p'_y p_x p_y b_x b_y ==
-(b_x - p'_x) * pue_f a_x a_y p_x p_y b_x b_y .
+  pue_f p'_x p'_y a_x a_y b_x b_y = 0 ->
+  (b_x - a_x) * pue_f p'_x p'_y p_x p_y b_x b_y =
+  (b_x - p'_x) * pue_f a_x a_y p_x p_y b_x b_y .
 Proof.
-move => on_ed .
+move => on_ed.
 rewrite pue_f_linear /pue_f (pue_f_on_edge_y on_ed).
-apply /eqP.
 mc_ring.
 Qed.
 
 Lemma pue_f_on_edge_same_point a_x a_y b_x b_y p_x p_y p_x' p_y':
-a_x != b_x ->
-pue_f p_x p_y a_x a_y b_x b_y == 0 ->
-pue_f p_x' p_y' a_x a_y b_x b_y == 0 ->
-(p_x == p_x') -> (p_y == p_y').
-Proof.
-move => axnbx puep0 puep'0.
-have pyeq := (pue_f_on_edge_y puep0 ).
-have p'yeq := (pue_f_on_edge_y puep'0 ).
+  a_x != b_x ->
+  pue_f p_x p_y a_x a_y b_x b_y = 0 ->
+  pue_f p_x' p_y' a_x a_y b_x b_y = 0 ->
+  p_x = p_x' -> p_y = p_y'.
+Proof.
+move=> axnbx puep0 puep'0.
+have pyeq := pue_f_on_edge_y puep0.
+have p'yeq := pue_f_on_edge_y puep'0.
 move=> xxs; have yys : (b_x - a_x) * p_y = (b_x - a_x) * p_y'.
-  by rewrite pyeq (eqP xxs) p'yeq.
-move: (axnbx); rewrite eq_sym -subr_eq0=> bxmax.
-apply/eqP.
-by apply: (mulfI bxmax).
+  by rewrite pyeq xxs p'yeq.
+move: (axnbx); rewrite eq_sym -subr_eq0.
+by move=> /mulfI; exact.
 Qed.
 
 Lemma pue_f_ax5 p_x p_y q_x q_y a_x a_y b_x b_y c_x c_y :
@@ -328,7 +307,7 @@ Lemma pue_f_triangle_decompose a_x a_y b_x b_y c_x c_y d_x d_y :
   pue_f b_x b_y c_x c_y d_x d_y.
 Proof.
 move=> online.
-rewrite -(eqP (ax4 _ _ _ _ _ _ d_x d_y)).
+rewrite -(ax4 _ _ _ _ _ _ d_x d_y).
 rewrite addrC; congr (_ + _).
 by rewrite addrC pue_f_o pue_f_c online oppr0 add0r -pue_f_c.
 Qed.
@@ -458,53 +437,52 @@ Proof.
 Qed.
 
 Lemma area3_vert a b c : (b.x = c.x) ->
-area3 a b c == (b.x - a.x) * (c.y - b.y).
+  area3 a b c = (b.x - a.x) * (c.y - b.y).
 Proof.
 move: a b c => [ax ay] [b_x b_y] [cx cy]/= <-.
-apply : pue_f_vert.
+exact: pue_f_vert.
 Qed.
 
 Lemma ax4_three_triangles p q r t :
-area3 t q r + area3 p t r + area3 p q t
-== area3 p q r.
+  area3 t q r + area3 p t r + area3 p q t = area3 p q r.
 Proof.
 move : p q r t => [px py] [q_x q_y] [rx ry] [t_x t_y]/= .
-apply : ax4.
+exact: ax4.
 Qed.
 
-
 Lemma area3_two_points a b :
-area3 a a b == 0 /\ area3 a b a == 0 /\
-area3 a b b == 0.
+  area3 a a b = 0 /\
+  area3 a b a = 0 /\
+  area3 a b b = 0.
 Proof.
 move : a b => [ax ay] [b_x b_y] /=.
-apply pue_f_two_points.
+exact: pue_f_two_points.
 Qed.
 
 Lemma area3_on_edge a b c d m :
-area3 m a b == 0 ->
-(b.x - a.x) * area3 m c d ==
-(m.x - a.x) * area3 b c d + (b.x - m.x) * area3 a c d.
+  area3 m a b = 0 ->
+  (b.x - a.x) * area3 m c d =
+  (m.x - a.x) * area3 b c d + (b.x - m.x) * area3 a c d.
 Proof.
 move : a b c d m => [ax ay] [b_x b_y] [cx cy] [dx dy] [mx my]/=.
-apply pue_f_on_edge.
+apply: pue_f_on_edge.
 Qed.
 
 Lemma area3_on_edge_y a b m :
-area3 m a b == 0 ->
-(b.x - a.x) * m.y = m.x * (b.y - a.y) - (a.x * b.y - b.x * a.y).
+  area3 m a b = 0 ->
+  (b.x - a.x) * m.y = m.x * (b.y - a.y) - (a.x * b.y - b.x * a.y).
 Proof.
 move : a b m => [ax ay] [b_x b_y]  [mx my]/=.
-apply pue_f_on_edge_y.
+exact: pue_f_on_edge_y.
 Qed.
 
 Lemma area3_triangle_on_edge a b p p' :
-area3 p' a b == 0 ->
-(b.x - a.x) * area3 p' a p ==
-(p'.x - a.x) * area3 b a p.
+  area3 p' a b = 0 ->
+  (b.x - a.x) * area3 p' a p =
+  (p'.x - a.x) * area3 b a p.
 Proof.
 move : a b p p' => [ax ay] [b_x b_y] [px py] [p'x p'y] /=.
-apply pue_f_triangle_on_edge.
+exact: pue_f_triangle_on_edge.
 Qed.
 
 Definition subpoint (p : pt) :=
@@ -565,8 +543,8 @@ Definition valid_edge :=
   generic_trajectories.valid_edge R le edge left_pt right_pt.
 
 Lemma valid_edge_extremities e0 p:
-(left_pt e0 == p) || (right_pt e0 == p) ->
-valid_edge e0 p.
+  (left_pt e0 == p) || (right_pt e0 == p) ->
+  valid_edge e0 p.
 Proof.
 rewrite /valid_edge/generic_trajectories.valid_edge.
 by move => /orP [/eqP eq |/eqP eq ];
@@ -583,10 +561,10 @@ Proof.
 by apply: valid_edge_extremities; rewrite eqxx orbT.
 Qed.
 
-Definition point_on_edge (p: pt) (e :edge) : bool :=
-  (area3 p (left_pt e) (right_pt e) == 0) && (valid_edge e p).
+Definition point_on_edge (p : pt) (e : edge) : bool :=
+  (area3 p (left_pt e) (right_pt e) == 0) && valid_edge e p.
 
-Notation "p '===' e" := (point_on_edge p e)( at level 70, no associativity).
+Notation "p '===' e" := (point_on_edge p e) (at level 70, no associativity).
 
 Definition edge_below (e1 : edge) (e2 : edge) : bool :=
 ((left_pt e1 <<= e2) && (right_pt e1 <<= e2))
@@ -601,8 +579,8 @@ Lemma edge_below_refl e : e <| e.
 Proof.
 apply/orP; left.
 rewrite 2!underE.
-rewrite (eqP (proj1 (area3_two_points _ _))).
-by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
+rewrite (proj1 (area3_two_points _ _)).
+by rewrite (proj1 (proj2 (area3_two_points _ _))) lexx.
 Qed.
 
 Lemma below_altC e1 e2 : below_alt e1 e2 <-> below_alt e2 e1.
@@ -630,79 +608,63 @@ Qed.
 
 Definition no_crossing := forall e1 e2, below_alt e1 e2.
 
-Definition no_crossing'  : Prop:=
+Definition no_crossing' : Prop :=
  forall e e' : edge,
  valid_edge e (left_pt e') ->
 (left_pt e' <<< e  -> e' <| e)  /\
 (~ (left_pt e' <<= e)  -> e <| e').
 
-Lemma left_on_edge e :
-(left_pt e) === e.
+Lemma left_on_edge e : left_pt e === e.
 Proof.
 move : e => [ l r inE].
 rewrite /point_on_edge //=.
-have := area3_two_points l r.
-move => [] ->  _ /=.
-apply  /andP .
-split.
-  by [].
-rewrite /=.
-by apply ltW.
+have [->/= _] := area3_two_points l r.
+rewrite eqxx/=.
+by apply/andP; split => //; exact: ltW.
 Qed.
 
-Lemma right_on_edge e :
-(right_pt e) === e.
+Lemma right_on_edge e : right_pt e === e.
 Proof.
 move : e => [ l r inE].
 rewrite /point_on_edge //=.
-have := area3_two_points r l.
-move => [] _ [] -> _ /=.
-apply  /andP .
-split.
-  rewrite /=.
-  by apply ltW.
-by [].
+have [_ [->/= _]] := area3_two_points r l.
+rewrite eqxx/=.
+by apply/andP; split => //; exact: ltW.
 Qed.
 
 Lemma point_on_edge_above low_e high_e a :
-a === high_e ->
-~~ (left_pt high_e <<< low_e) ->
-~~ (right_pt high_e <<< low_e) ->
-~~ (a <<< low_e).
+  a === high_e ->
+  ~~ (left_pt high_e <<< low_e) ->
+  ~~ (right_pt high_e <<< low_e) ->
+  ~~ (a <<< low_e).
 Proof.
 move : high_e => [lr hr inH] /=.
-rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+rewrite /point_on_edge /valid_edge => /andP [] /= /eqP poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
 rewrite /point_strictly_under_edge.
 rewrite /generic_trajectories.point_strictly_under_edge subrr.
 rewrite !R_ltb_lt -!leNgt => llrllh llrllrh.
-have diffa : (lr.x - a.x) <= 0.
-  by rewrite subr_cp0.
-have diffb : (hr.x - a.x) >= 0.
-  by rewrite subr_cp0.
-have difflh : (lr.x - hr.x) < 0.
-  by rewrite subr_cp0.
-rewrite -(ler_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_le0 (eqP pf).
+have diffa : lr.x - a.x <= 0 by rewrite subr_cp0.
+have diffb : hr.x - a.x >= 0 by rewrite subr_cp0.
+have difflh : lr.x - hr.x < 0 by rewrite subr_cp0.
+rewrite -(ler_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_le0 pf.
 by rewrite addr_ge0 // mulr_ge0 // subr_ge0.
 Qed.
 
 Lemma point_on_edge_above_strict low_e high_e a :
-a === high_e ->
-(left_pt high_e >>> low_e) ->
-(right_pt high_e >>> low_e) ->
-(a >>> low_e).
+  a === high_e ->
+  left_pt high_e >>> low_e ->
+  right_pt high_e >>> low_e ->
+  a >>> low_e.
 Proof.
 move : high_e => [lr hr inH] /=.
-rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+rewrite /point_on_edge /valid_edge => /andP [] /= /eqP poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt low_e) (right_pt low_e) poea.
 rewrite /point_under_edge -!ltNge !subrr => llrllh llrllrh.
-have diffa : (lr.x - a.x) <= 0.
-  by rewrite subr_cp0.
-have diffb : (hr.x - a.x) >= 0.
-  by rewrite subr_cp0.
-have difflh : (lr.x - hr.x) < 0.
-  by rewrite subr_cp0.
-rewrite -(ltr_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_lt0 (eqP pf).
+have diffa : lr.x - a.x <= 0 by rewrite subr_cp0.
+have diffb : hr.x - a.x >= 0 by rewrite subr_cp0.
+have difflh : lr.x - hr.x < 0 by rewrite subr_cp0.
+rewrite -(ltr_nM2l difflh _ 0) mulr0 -opprB mulNr oppr_lt0 pf.
 have addr_le_gt0 (x y : R) : 0 <= x -> 0 < y -> 0 < x + y.
   move=> xge0 ygt0; rewrite -(add0r 0).
   by apply: ler_ltD.
@@ -715,47 +677,40 @@ by rewrite mulr_gt0 // subr_gt0.
 Qed.
 
 Lemma point_on_edge_under low_e high_e a :
-a === (low_e) ->
- (left_pt low_e) <<= high_e ->
- (right_pt low_e) <<= high_e ->
+  a === (low_e) ->
+  left_pt low_e <<= high_e ->
+  right_pt low_e <<= high_e ->
   a <<= high_e.
 Proof.
 move : low_e => [lr hr inH] /=.
-rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+rewrite /point_on_edge /valid_edge => /andP [] /= /eqP poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
 rewrite /point_under_edge /generic_trajectories.point_under_edge !subrr=> llrllh llrllrh.
-have diffa : (lr.x - a.x) <= 0.
-  by rewrite subr_cp0.
-have diffb : (hr.x - a.x) >= 0.
-  by rewrite subr_cp0.
-have difflh : (lr.x - hr.x) < 0.
-  by rewrite subr_cp0.
-rewrite -(ler_nM2r difflh 0 _) mul0r mulrC -opprB mulNr (eqP pf) opprD.
+have diffa : lr.x - a.x <= 0 by rewrite subr_cp0.
+have diffb : hr.x - a.x >= 0 by rewrite subr_cp0.
+have difflh : lr.x - hr.x < 0 by rewrite subr_cp0.
+rewrite -(ler_nM2r difflh 0 _) mul0r mulrC -opprB mulNr pf opprD.
 by rewrite addr_ge0 // -mulNr mulr_le0 // oppr_le0 subr_cp0.
 Qed.
 
 Lemma point_on_edge_under_strict high_e low_e a :
-a === low_e ->
-(left_pt low_e <<< high_e) ->
-(right_pt low_e <<< high_e) ->
-(a <<< high_e).
+  a === low_e ->
+  left_pt low_e <<< high_e ->
+  right_pt low_e <<< high_e ->
+  a <<< high_e.
 Proof.
 move : low_e => [lr hr inH] /=.
-rewrite /point_on_edge /valid_edge => /andP [] /= poea /andP [] linfa ainfr.
+rewrite /point_on_edge /valid_edge => /andP [] /= /eqP poea /andP [] linfa ainfr.
 have pf := area3_on_edge (left_pt high_e) (right_pt high_e) poea.
 rewrite /point_strictly_under_edge.
 rewrite/generic_trajectories.point_strictly_under_edge.
 rewrite !R_ltb_lt !subrr=> llrllh llrllrh.
-have diffa : (lr.x - a.x) <= 0.
-  by rewrite subr_cp0.
-have diffb : (hr.x - a.x) >= 0.
-  by rewrite subr_cp0.
-have difflh : (lr.x - hr.x) < 0.
-  by rewrite subr_cp0.
-rewrite -(ltr_nM2l difflh 0) mulr0 -opprB mulNr oppr_gt0 (eqP pf).
+have diffa : lr.x - a.x <= 0 by rewrite subr_cp0.
+have diffb : hr.x - a.x >= 0 by rewrite subr_cp0.
+have difflh : lr.x - hr.x < 0 by rewrite subr_cp0.
+rewrite -(ltr_nM2l difflh 0) mulr0 -opprB mulNr oppr_gt0 pf.
 have addr_le_lt0 (x y : R) : x <= 0 -> y < 0 -> x + y < 0.
-  move=> xle0 ylt0; rewrite -(add0r 0).
-  by apply: ler_ltD.
+  by move=> xle0 ylt0; rewrite -(add0r 0) ler_ltD.
 move: diffa; rewrite le_eqVlt=> /orP[ | diffa]; last first.
   rewrite addrC addr_le_lt0 // ?nmulr_llt0 ?mulr_ge0_le0 //.
       by rewrite ltW.
@@ -765,46 +720,41 @@ by rewrite nmulr_llt0 // subr_gt0.
 Qed.
 
 Lemma not_strictly_above' low_e high_e p':
-~~ (left_pt (high_e) <<< low_e) ->
-~~ (right_pt (high_e) <<< low_e) ->
-p' ===  high_e ->  (right_pt (low_e)).x = p'.x  ->
-right_pt (low_e) <<= high_e .
+  ~~ (left_pt (high_e) <<< low_e) ->
+  ~~ (right_pt (high_e) <<< low_e) ->
+  p' ===  high_e ->  (right_pt (low_e)).x = p'.x  ->
+  right_pt (low_e) <<= high_e .
 Proof.
 move : low_e => [ll lr inL] /=.
 move => pablh pabrh poep' eqxp'p.
-have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inL)) eqxp'p .
+have /= puefcpp' := area3_vert (left_pt (Bedge inL)) eqxp'p .
 have := (point_on_edge_above poep' pablh pabrh ).
 rewrite strictE.
 rewrite -area3_cycle -leNgt puefcpp' underE.
-have inle: (lr.x - ll.x) >0.
-  by rewrite subr_cp0.
+have inle : lr.x - ll.x > 0 by rewrite subr_cp0.
 rewrite (pmulr_rge0 _ inle) => inp'lr.
-have :=  (ax4_three_triangles lr  (left_pt high_e) (right_pt high_e) p') => /eqP <-.
+have <- := ax4_three_triangles lr  (left_pt high_e) (right_pt high_e) p'.
 move : poep'.
 rewrite /point_on_edge=> /andP [] /eqP pue0 valp'.
 rewrite pue0.
 have := (area3_vert (right_pt high_e) eqxp'p  ).
-rewrite -area3_cycle eqxp'p => /eqP ->.
+rewrite -area3_cycle eqxp'p => ->.
 move : valp'.
 rewrite /valid_edge => /andP [] xlhp' xrhp'.
-have xrhp'0: p'.x - (right_pt high_e).x <=0.
-  by rewrite subr_cp0.
-rewrite add0r.
-rewrite -oppr_ge0 opprD /= addr_ge0//.
+have xrhp'0: p'.x - (right_pt high_e).x <= 0 by rewrite subr_cp0.
+rewrite add0r -oppr_ge0 opprD /= addr_ge0//.
   by rewrite -mulNr mulr_ge0 // oppr_ge0.
-have := (area3_vert (left_pt high_e) eqxp'p  ).
-rewrite -area3_opposite area3_cycle eqxp'p => /eqP ->.
-have xlhp'0: p'.x - (left_pt high_e).x >= 0.
-  by rewrite subr_cp0.
-by rewrite  mulr_ge0.
+have := area3_vert (left_pt high_e) eqxp'p.
+rewrite -area3_opposite area3_cycle eqxp'p => ->.
+have xlhp'0: p'.x - (left_pt high_e).x >= 0 by rewrite subr_cp0.
+by rewrite mulr_ge0.
 Qed.
 
-Lemma under_above_on e p :
-  valid_edge e p -> p <<= e -> p >>= e -> p === e.
+Lemma under_above_on e p : valid_edge e p -> p <<= e -> p >>= e -> p === e.
 Proof.
 move=> v u a; apply/andP; split => //.
 apply/eqP/le_anti/andP;split.
-  by move: u; rewrite /point_under_edge/generic_trajectories.point_under_edge!subrr.
+  by move: u; rewrite /point_under_edge /generic_trajectories.point_under_edge !subrr.
 move: a; rewrite /point_strictly_under_edge.
 rewrite /generic_trajectories.point_strictly_under_edge subrr.
 by rewrite R_ltb_lt leNgt=> it; exact: it.
@@ -826,49 +776,39 @@ rewrite /generic_trajectories.vertical_intersection_point /=.
 by rewrite /valid_edge in h; rewrite (negbTE h).
 Qed.
 
-
 Lemma vertical_correct p e :
-    match (vertical_intersection_point p e) with
+    match vertical_intersection_point p e with
   None => ~~ valid_edge e p | Some(i) => i === e end.
 Proof.
 move: p e => [ptx pty] [[ax ay] [bx b_y]  /=ab] .
 rewrite /vertical_intersection_point/valid_edge.
 rewrite /generic_trajectories.vertical_intersection_point.
-case : ifP => /= h ; last first.
-by [].
-have: ax != bx.
-rewrite neq_lt ab //=.
-rewrite /area3.
+case : ifP => /= h ; last by [].
+have: ax != bx by rewrite neq_lt ab.
 set py := ((b_y - ay) / (bx - ax) * ptx + (ay - (b_y - ay) / (bx - ax) * ax)).
 move => h2.
 rewrite /point_on_edge .
-apply /andP.
-split; last first.
-exact h.
-apply pue_f_inters.
-by apply /eqP /nesym /eqP .
-by [].
+apply/andP; split; last exact h.
+apply/eqP.
+apply pue_f_inters => //.
+by rewrite eq_sym.
 Qed.
 
-
-
 Lemma exists_point_valid e p :
-(valid_edge e p) ->
-exists p', vertical_intersection_point p e = Some (p').
+  valid_edge e p ->
+  exists p', vertical_intersection_point p e = Some p'.
 Proof.
 have := vertical_correct p e.
-case : (vertical_intersection_point p e)=> [vp |//=].
-  rewrite /point_on_edge.
-  move => a b.
+case : (vertical_intersection_point p e)=> [vp |//= a b].
+  rewrite /point_on_edge  => a b.
   by exists vp.
-move => a b.
 exists p.
 by rewrite b in a.
 Qed.
 
 Lemma intersection_on_edge e p p' :
-vertical_intersection_point p e = Some (p') ->
-p'=== e /\ p.x = p'.x.
+  vertical_intersection_point p e = Some p' ->
+  p' === e /\ p.x = p'.x.
 Proof.
 have := vertical_correct p e.
 case vert : (vertical_intersection_point p e)=> [vp |//=].
@@ -876,142 +816,125 @@ move: vert.
 rewrite /vertical_intersection_point.
 rewrite /generic_trajectories.vertical_intersection_point.
 case : (generic_trajectories.valid_edge _ _ _ _ _ e p) => [| //].
-move => [] /= vpq  poe [].
-move => <-.
-by rewrite poe -vpq /=.
+move => [] /= vpq  poe [] <-.
+by rewrite poe -vpq.
 Qed.
 
 Lemma not_strictly_under' low_e high_e p' :
-(left_pt (low_e)) <<= (high_e) ->
-(right_pt (low_e))<<= (high_e) ->
+  left_pt (low_e) <<= high_e ->
+  right_pt (low_e) <<= high_e ->
 (* This is an alternative way to say
   valid_edge low_e (right_pt high_e) *)
-p' === low_e ->  (right_pt (high_e)).x = p'.x  ->
-~~ (right_pt (high_e) <<< low_e).
+  p' === low_e -> (right_pt (high_e)).x = p'.x  ->
+  ~~ (right_pt (high_e) <<< low_e).
 Proof.
 move : high_e => [hl hr inH] /=.
 move => pablh pabrh poep' eqxp'p.
-have /= /eqP puefcpp' := area3_vert (left_pt (Bedge inH)) eqxp'p .
-have := (point_on_edge_under poep' pablh pabrh ).
+have /= puefcpp' := area3_vert (left_pt (Bedge inH)) eqxp'p .
+have := point_on_edge_under poep' pablh pabrh.
 rewrite underE strictE.
 rewrite -area3_cycle.
 rewrite -leNgt puefcpp'.
-have inle: (hr.x - hl.x) >0.
-  by rewrite subr_cp0.
+have inle : hr.x - hl.x > 0 by rewrite subr_cp0.
 rewrite (pmulr_rle0 _ inle )  => inp'hr.
-have :=  (ax4_three_triangles hr  (left_pt low_e) (right_pt low_e) p') => /eqP <-.
+have <- := ax4_three_triangles hr (left_pt low_e) (right_pt low_e) p'.
 move : poep'.
 rewrite /point_on_edge=> /andP [] /eqP pue0 valp'.
 rewrite pue0.
-have := (area3_vert (right_pt low_e) eqxp'p  ).
-rewrite -area3_cycle eqxp'p => /eqP ->.
+have := area3_vert (right_pt low_e) eqxp'p.
+rewrite -area3_cycle eqxp'p => ->.
 move : valp'.
 rewrite /valid_edge => /andP [] xlhp' xrhp'.
-have xrhp'0: p'.x - (right_pt low_e).x <=0.
-  by rewrite subr_cp0.
-rewrite add0r addr_ge0//.
-  by rewrite mulr_le0.
-have := (area3_vert (left_pt low_e) eqxp'p  ).
-rewrite area3_opposite -area3_cycle eqxp'p eqr_oppLR => /eqP ->.
+have xrhp'0 : p'.x - (right_pt low_e).x <= 0 by rewrite subr_cp0.
+rewrite add0r addr_ge0// ?mulr_le0//.
+have := area3_vert (left_pt low_e) eqxp'p.
+rewrite area3_opposite -area3_cycle eqxp'p => /eqP; rewrite eqr_oppLR => /eqP ->.
 by rewrite -mulNr mulr_le0 // oppr_le0 subr_cp0.
 Qed.
 
-Lemma pue_right_edge e p :
-(right_pt e).x == p.x ->
-(p <<= e) = ((p.y - (right_pt e).y) <= 0).
+Lemma pue_right_edge e p : (right_pt e).x = p.x ->
+  (p <<= e) = (p.y - (right_pt e).y <= 0).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
-rewrite /point_under_edge/generic_trajectories.point_under_edge /=.
-move => /eqP <- /=.
-have := (pue_f_vert py ax ay bx b_y).
-rewrite pue_f_c /pue_f.
-move => /eqP ->.
+rewrite /point_under_edge/generic_trajectories.point_under_edge /= => <-/=.
+have := pue_f_vert py ax ay bx b_y.
+rewrite pue_f_c /pue_f => ->.
 rewrite -subr_cp0 -opprB oppr_lt0 in inE.
 by rewrite subrr (pmulr_rle0 _  inE) .
 Qed.
 
-Lemma psue_right_edge e p :
-(right_pt e).x == p.x ->
-(p <<< e) = ((p.y - (right_pt e).y) < 0).
+Lemma psue_right_edge e p : (right_pt e).x = p.x ->
+  (p <<< e) = (p.y - (right_pt e).y < 0).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= cnd] [px py]  /=.
 rewrite /point_strictly_under_edge/generic_trajectories.point_strictly_under_edge /=.
-rewrite R_ltb_lt.
-move => /eqP <- /=.
-have := (pue_f_vert py ax ay bx b_y).
-rewrite pue_f_c /pue_f.
-move => /eqP ->.
+rewrite R_ltb_lt => <- /=.
+have := pue_f_vert py ax ay bx b_y.
+rewrite pue_f_c /pue_f => ->.
 rewrite -subr_gt0 in cnd.
-by rewrite subrr (pmulr_rlt0 _  cnd) .
+by rewrite subrr (pmulr_rlt0 _  cnd).
 Qed.
 
-Lemma pue_left_edge e p :
-(left_pt e).x == p.x ->
-(p <<= e) = (0 <= ((left_pt e).y - p.y )).
+Lemma pue_left_edge e p : (left_pt e).x = p.x ->
+  (p <<= e) = (0 <= (left_pt e).y - p.y).
 Proof.
 move : e p  => [[ax ay][bx b_y] /= inE] [px py]  /=.
 rewrite /point_under_edge.
-rewrite /generic_trajectories.point_under_edge /=.
-move => /eqP <- /=.
-have := (pue_f_vert ay bx b_y ax py).
-rewrite -pue_f_c /pue_f.
-move => /eqP ->.
+rewrite /generic_trajectories.point_under_edge /= => <- /=.
+have := pue_f_vert ay bx b_y ax py.
+rewrite -pue_f_c /pue_f => ->.
 rewrite -subr_cp0 in inE.
 by rewrite subrr (nmulr_rle0 _  inE).
 Qed.
 
-Lemma psue_left_edge e p :
-(left_pt e).x == p.x ->
-(p <<< e) = (0 < (left_pt e).y - p.y).
+Lemma psue_left_edge e p : (left_pt e).x = p.x ->
+  (p <<< e) = (0 < (left_pt e).y - p.y).
 Proof.
-move: e p => [[ax ay][bx b_y] /= cnd] [px py] /=.
-move=> /eqP <- /=.
+move: e p => [[ax ay][bx b_y] /= cnd] [px py] /= <- /=.
 rewrite /point_strictly_under_edge.
 rewrite /generic_trajectories.point_strictly_under_edge /=.
 rewrite R_ltb_lt.
-have := (pue_f_vert ay bx b_y ax py).
-rewrite -pue_f_c /pue_f => /eqP ->.
+have := pue_f_vert ay bx b_y ax py.
+rewrite -pue_f_c /pue_f => ->.
 rewrite -subr_cp0 in cnd.
 by rewrite subrr (nmulr_rlt0 _ cnd).
 Qed.
 
 Lemma not_strictly_under low_e high_e  :
-(left_pt low_e) <<= high_e ->
-(right_pt low_e) <<= high_e ->
-valid_edge low_e (right_pt high_e)  ->
-~~ (right_pt high_e <<< low_e).
+  left_pt low_e <<= high_e ->
+  right_pt low_e <<= high_e ->
+  valid_edge low_e (right_pt high_e) ->
+  ~~ (right_pt high_e <<< low_e).
 Proof.
 move => pableft pabright valright.
-have  := exists_point_valid valright.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx.
-apply :  not_strictly_under' pableft pabright poep' eqx.
+have [p' vip] := exists_point_valid valright.
+have := intersection_on_edge vip => [][] poep' eqx.
+by apply: not_strictly_under' pableft pabright poep' eqx.
 Qed.
 
 Lemma not_strictly_above low_e high_e :
-~~ (left_pt high_e <<< low_e) ->
-~~ (right_pt high_e <<< low_e) ->
-valid_edge (high_e) (right_pt (low_e)) ->
-right_pt (low_e) <<= high_e.
+  ~~ (left_pt high_e <<< low_e) ->
+  ~~ (right_pt high_e <<< low_e) ->
+  valid_edge high_e (right_pt low_e) ->
+  right_pt low_e <<= high_e.
 Proof.
 move => pableft pabright valright.
-have  := exists_point_valid valright.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx.
-apply :  not_strictly_above' pableft pabright poep' eqx.
+have [p' vip] := exists_point_valid valright.
+have := intersection_on_edge vip => [][] poep' eqx.
+by apply: not_strictly_above' pableft pabright poep' eqx.
 Qed.
 
 Lemma on_edge_same_point e p p':
-p === e -> p' === e ->
-(p.x == p'.x) -> (p.y == p'.y).
+  p === e -> p' === e ->
+  p.x = p'.x -> p.y = p'.y.
 Proof.
 move : e => [l r ec].
 rewrite /point_on_edge /= => /andP [] p0 _ /andP[] p'0 _.
 have dif : l.x != r.x.
   by apply/eqP=> abs; move: ec; rewrite abs ltxx.
-move: l r p0 p'0 dif {ec}=> [a_x a_y][b_x b_y] p0 p'0 dif.
+move: l r p0 p'0 dif {ec}=> [a_x a_y][b_x b_y] /eqP p0 /eqP p'0 dif.
 move: p p' p0 p'0 => [x y] [x' y'] puep0 puep'0.
-rewrite /=; apply: (pue_f_on_edge_same_point dif puep0 puep'0).
+exact: pue_f_on_edge_same_point dif puep0 puep'0.
 Qed.
 
 Lemma strict_under_edge_lower_y r r' e :
@@ -1025,47 +948,42 @@ move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
     have rltr : r'.x < (right_pt e).x by rewrite -rr' -atl edge_cond.
     have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
     by move/andP: rone => [] -> _ /eqP.
-  by move/eqP/psue_left_edge: atl; rewrite subr_gt0 -req.
+  by move/psue_left_edge : atl; rewrite subr_gt0 -req.
 have rue' : (r <<< e) = (area3 r (left_pt e) r' < 0).
-  move: rone=> /andP[] /[dup] tmp/area3_triangle_on_edge + _ => /(_ r).
+  move: rone=> /andP[] /[dup] tmp /eqP /area3_triangle_on_edge + _ => /(_ r).
 (* TODO : fix area3_triangle_on_edge for cycle *)
   rewrite (area3_opposite (left_pt _)).
   rewrite (area3_opposite (left_pt _) _ (right_pt _)) !mulrN.
-  rewrite inj_eq; last by apply: oppr_inj.
-  move/eqP => signcond.
+  move=> /eqP; rewrite eqr_opp => /eqP signcond.
   move: (edge_cond e); rewrite -subr_gt0 => /pmulr_rlt0 <-.
   rewrite signcond pmulr_rlt0; last by rewrite subr_gt0 -rr'.
-    rewrite /point_strictly_under_edge.
-    by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
+  rewrite /point_strictly_under_edge.
+  by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
 have inr' : (left_pt e).x < r'.x by rewrite -rr'.
-have /psue_right_edge : (right_pt (Bedge inr')).x == r.x.
-  by rewrite /= rr' eqxx.
+have /psue_right_edge : (right_pt (Bedge inr')).x = r.x by rewrite /= rr'.
 rewrite rue' subr_lt0.
 rewrite /point_strictly_under_edge.
 by rewrite /generic_trajectories.point_strictly_under_edge subrr R_ltb_lt.
 Qed.
 
-Lemma under_onVstrict e p :
-  valid_edge e p ->
+Lemma under_onVstrict e p : valid_edge e p ->
   (p <<= e) = (p === e) || (p <<< e).
 Proof.
 move=> valep.
 rewrite /point_under_edge /point_strictly_under_edge /point_on_edge.
 rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt.
 rewrite /generic_trajectories.point_under_edge subrr.
-by rewrite le_eqVlt valep andbT.
+by rewrite valep andbT -le_eqVlt.
 Qed.
 
 Lemma onAbove e p : p === e -> ~~ (p <<< e).
 Proof.
 rewrite /point_on_edge /point_strictly_under_edge.
 rewrite /generic_trajectories.point_strictly_under_edge R_ltb_lt subrr.
-move=> /andP[cmp valep].
-by rewrite -leNgt le_eqVlt eq_sym cmp.
+by move=> /andP[/eqP -> valep]; rewrite ltxx.
 Qed.
 
-Lemma strict_nonAunder e p :
-  valid_edge e p ->
+Lemma strict_nonAunder e p : valid_edge e p ->
   (p <<< e) = (~~ (p === e)) && (p <<= e).
 Proof.
 move=> valep.
@@ -1082,7 +1000,7 @@ move=> xs nq under on'.
 have  vr : valid_edge e r.
   by move: on'; rewrite /valid_edge/generic_trajectories.valid_edge xs=> /andP[].
 move: under; rewrite (under_onVstrict vr)=> /orP[on | ].
-  by case/negP: nq; rewrite pt_eqE (on_edge_same_point on on') xs eqxx.
+  by case/negP: nq; rewrite pt_eqE (on_edge_same_point on on') xs// !eqxx.
 by rewrite (strict_under_edge_lower_y xs).
 Qed.
 
@@ -1108,50 +1026,48 @@ move: (valre)=> /andP[] + _; rewrite le_eqVlt=> /orP[/eqP atl| inr].
     have rltr : r'.x < (right_pt e).x by rewrite -rr' -atl edge_cond.
     have /esym := edge_and_left_vertical_eq rltr (esym (etrans atl rr')).
     by move/andP: rone => [] -> _ /eqP.
-  by move/eqP/pue_left_edge: atl; rewrite subr_ge0 -req.
+  by move/pue_left_edge: atl; rewrite subr_ge0 -req.
 have rue' : (r <<= e) = (area3 r (left_pt e) r' <= 0).
-  move: rone=> /andP[] /[dup] tmp/area3_triangle_on_edge + _ => /(_ r).
+  move: rone=> /andP[] /[dup] tmp /eqP /area3_triangle_on_edge + _ => /(_ r).
 (* TODO : fix area3_triangle_on_edge for cycle *)
   rewrite (area3_opposite (left_pt _)).
   rewrite (area3_opposite (left_pt _) _ (right_pt _)) !mulrN.
-  rewrite inj_eq; last by apply: oppr_inj.
+  move=> /eqP; rewrite inj_eq; last by apply: oppr_inj.
   move/eqP => signcond.
   move: (edge_cond e); rewrite -subr_gt0 => /pmulr_rle0 <-.
   rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
   by rewrite signcond pmulr_rle0; last rewrite subr_gt0 -rr'.
 have inr' : (left_pt e).x < r'.x by rewrite -rr'.
 rewrite /point_under_edge/generic_trajectories.point_under_edge subrr.
-have /pue_right_edge : (right_pt (Bedge inr')).x == r.x.
-  by rewrite /= rr' eqxx.
+have /pue_right_edge : (right_pt (Bedge inr')).x = r.x by rewrite /= rr'.
 move: rue'.
 rewrite /point_under_edge/generic_trajectories.point_under_edge subrr=> rue'.
 by rewrite rue' subr_le0.
 Qed.
 
 Lemma aligned_trans a a' b p : a.x != b.x ->
-  area3 a' a b == 0 ->
-  area3 p a b == 0 -> area3 p a' b == 0.
+  area3 a' a b = 0 -> area3 p a b = 0 -> area3 p a' b = 0.
 Proof.
 rewrite -area3_cycle.
-move=> bna /[dup]/area3_triangle_on_edge proc a'ab pab.
-have/mulfI/inj_eq <-  : a.x - b.x != 0 by rewrite subr_eq0.
-rewrite -area3_cycle -(eqP (proc _)).
-by rewrite area3_cycle (eqP pab) !mulr0.
+move=> bna /[dup] /area3_triangle_on_edge proc a'ab pab.
+apply/eqP.
+have /mulfI/inj_eq <- : a.x - b.x != 0 by rewrite subr_eq0.
+by rewrite -area3_cycle -(proc _) area3_cycle pab !mulr0.
 Qed.
 
 Lemma area3_change_ext a b a' b' p :
   a.x < b.x -> a'.x < b'.x ->
-  area3 a' a b == 0 -> area3 b' a b == 0 ->
+  area3 a' a b = 0 -> area3 b' a b = 0 ->
   sg (area3 p a b) = sg (area3 p a' b').
 Proof.
 move=> altb altb' ona onb.
-have/area3_triangle_on_edge:= ona => /(_ p)/eqP ona'.
-have/area3_triangle_on_edge:= onb => /(_ p)/eqP onb0.
-have/area3_triangle_on_edge: area3 b' a' a == 0.
+have /area3_triangle_on_edge := ona => /(_ p) ona'.
+have /area3_triangle_on_edge := onb => /(_ p) onb0.
+have /area3_triangle_on_edge : area3 b' a' a = 0.
   have bna : b.x != a.x by case: ltrgtP altb.
-  by rewrite (aligned_trans bna) //
-       area3_opposite oppr_eq0 area3_cycle.
-move=>/(_ p)/eqP onb'.
+  by rewrite (aligned_trans bna) // area3_opposite;
+    apply/eqP; rewrite oppr_eq0 area3_cycle; exact/eqP.
+move=>/(_ p) onb'.
 have difab : 0 < b.x - a.x by rewrite subr_gt0.
 have difab' : 0 < b'.x - a'.x by rewrite subr_gt0.
 have [ | | aa' ] := ltrgtP (a.x) (a'.x); last first.
@@ -1159,8 +1075,9 @@ have [ | | aa' ] := ltrgtP (a.x) (a'.x); last first.
   have/on_edge_same_point tmp : a === Bedge altb by exact: left_on_edge.
   have/(tmp _) : a' === Bedge altb.
     rewrite /point_on_edge ona /valid_edge/generic_trajectories.valid_edge.
+    rewrite eqxx/=.
     by rewrite /= -aa' lexx ltW.
-  rewrite aa'=> /(_ (eqxx _))/eqP ays.
+  rewrite aa' => /(_ erefl) ays.
   have aa : a = a' by move: (a) (a') aa' ays=> [? ?][? ?] /= -> ->.
   rewrite -aa area3_opposite [in RHS]area3_opposite.
   rewrite -[RHS]mul1r -(gtr0_sg difab) -sgrM mulrN onb0 [X in _ - X]aa' -mulrN.
@@ -1170,7 +1087,7 @@ have [ | | aa' ] := ltrgtP (a.x) (a'.x); last first.
   rewrite -area3_opposite -[in RHS]area3_cycle.
   rewrite -(gtr0_sg difab) -sgrM ona' [in RHS]area3_opposite.
   by rewrite mulrN -mulNr opprB sgrM (gtr0_sg xalta') mul1r.
-rewrite -subr_lt0=> xa'lta; apply/esym. 
+rewrite -subr_lt0=> xa'lta; apply/esym.
 rewrite area3_opposite -[X in -X]mul1r -mulNr sgrM sgrN1.
 rewrite -(ltr0_sg xa'lta) -sgrM onb' sgrM (gtr0_sg difab').
 rewrite area3_opposite -area3_cycle sgrN mulrN -(gtr0_sg difab).
@@ -1179,20 +1096,17 @@ by rewrite area3_opposite sgrN mulrN mulNr opprK mul1r.
 Qed.
 
 Lemma under_low_imp_under_high low_e high_e p  :
-(left_pt low_e) <<= high_e ->
-(right_pt low_e) <<= high_e ->
-valid_edge low_e p ->
-valid_edge high_e p ->
-p <<= low_e -> p <<= high_e.
-Proof.
-move : low_e high_e => [ll lr inL] [hl hr inH]  /=.
-move => pulh purh vallow valhigh.
-have  := exists_point_valid vallow.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx'.
-have  := exists_point_valid valhigh.
-move => [] p'' vip' .
-have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+  left_pt low_e <<= high_e ->
+  right_pt low_e <<= high_e ->
+  valid_edge low_e p ->
+  valid_edge high_e p ->
+  p <<= low_e -> p <<= high_e.
+Proof.
+move : low_e high_e => [ll lr inL] [hl hr inH] /= pulh purh vallow valhigh.
+have [p' vip] := exists_point_valid vallow.
+have := intersection_on_edge vip => [][] poep' eqx'.
+have [p'' vip'] := exists_point_valid valhigh.
+have := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
 have := poep''.
 have := poep'.
 
@@ -1205,28 +1119,24 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => puep.
 
-have ydiff : p.y <= p'.y.
-  by rewrite -(under_edge_lower_y eqx' poep').
+have ydiff : p.y <= p'.y by rewrite -(under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
-have puep' := (point_on_edge_under  poep' pulh purh).
-have y'diff : p'.y <= p''.y.
-  by rewrite -(under_edge_lower_y eqx'' poep'').
-have y''diff: (p.y  <= p''.y).
-  by rewrite (le_trans  ydiff y'diff).
+have puep' := point_on_edge_under  poep' pulh purh.
+have y'diff : p'.y <= p''.y by rewrite -(under_edge_lower_y eqx'' poep'').
+have y''diff : p.y  <= p''.y by rewrite (le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
-have /eqP pHleq :=  (area3_vert hl eqx'').
+have pHleq := area3_vert hl eqx''.
 have /eqP pHreq :=  (area3_vert hr eqx'').
 rewrite -area3_cycle in pHreq.
 rewrite area3_opposite -area3_cycle in pHleq.
 
-move : poepf'' pHreq => /eqP ->  -> .
-have :  area3 p hl p'' = - ((p.x - hl.x) * (p''.y - p.y)).
-  by rewrite -pHleq opprK.
+move : poepf'' pHreq => /eqP -> /eqP -> .
+have : area3 p hl p'' = - ((p.x - hl.x) * (p''.y - p.y)) by rewrite -pHleq opprK.
 move => ->.
 rewrite add0r -mulrBl.
-rewrite  [x in (x - _) * _ == _] addrC.
+rewrite  [x in (x - _) * _ = _] addrC.
 rewrite addrKA opprK.
 
 rewrite /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
@@ -1235,25 +1145,23 @@ rewrite addrC.
 have inH' := inH.
 rewrite -subr_cp0 in inH'.
 rewrite -subr_ge0 in y''diff.
-move => /eqP <-.
+move => <-.
 by rewrite nmulr_rle0.
 Qed.
 
 Lemma under_low_imp_strict_under_high low_e high_e p  :
-(left_pt low_e) <<= high_e ->
-(right_pt low_e) <<= high_e ->
-valid_edge low_e p ->
-valid_edge high_e p ->
-p <<< low_e -> p <<< high_e.
+  left_pt low_e <<= high_e ->
+  right_pt low_e <<= high_e ->
+  valid_edge low_e p ->
+  valid_edge high_e p ->
+  p <<< low_e -> p <<< high_e.
 Proof.
 move : low_e high_e => [ll lr inL] [hl hr inH]  /=.
 move => pulh purh vallow valhigh.
-have  := exists_point_valid vallow.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx'.
-have  := exists_point_valid valhigh.
-move => [] p'' vip' .
-have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
+have [p' vip] := exists_point_valid vallow.
+have := intersection_on_edge vip => [][] poep' eqx'.
+have [p'' vip'] := exists_point_valid valhigh.
+have := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
 have := poep''.
 have := poep'.
 
@@ -1265,28 +1173,25 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => puep.
 
-have ydiff : p.y < p'.y.
-  by rewrite -(strict_under_edge_lower_y eqx' poep').
+have ydiff : p.y < p'.y by rewrite -(strict_under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
-have puep' := (point_on_edge_under  poep' pulh purh).
-have y'diff : p'.y <= p''.y.
-  by rewrite -(under_edge_lower_y eqx'' poep'').
-have y''diff: (p.y  < p''.y).
-  by rewrite (lt_le_trans  ydiff y'diff).
+have puep' := point_on_edge_under  poep' pulh purh.
+have y'diff : p'.y <= p''.y by rewrite -(under_edge_lower_y eqx'' poep'').
+have y''diff : p.y  < p''.y by rewrite (lt_le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
-have /eqP pHleq :=  (area3_vert hl eqx'').
-have /eqP pHreq :=  (area3_vert hr eqx'').
+have pHleq := area3_vert hl eqx''.
+have /eqP pHreq := area3_vert hr eqx''.
 rewrite -area3_cycle in pHreq.
 rewrite area3_opposite -area3_cycle in pHleq.
 
-move : poepf'' pHreq => /eqP ->  -> .
+move : poepf'' pHreq => /eqP -> /eqP -> .
 have :  area3 p hl p'' = - ((p.x - hl.x) * (p''.y - p.y)).
   by rewrite -pHleq opprK.
 move => ->.
 rewrite add0r -mulrBl.
-rewrite  [x in (x - _) * _ == _] addrC.
+rewrite [x in (x - _) * _ = _]addrC.
 rewrite addrKA opprK.
 
 rewrite /= {pulh purh vallow valhigh poep' poep'' poepf' puep puep'}.
@@ -1294,25 +1199,22 @@ rewrite addrC.
 have inH' := inH.
 rewrite -subr_cp0 in inH'.
 rewrite -subr_gt0 in y''diff.
-rewrite strictE.
-move => /eqP <-.
+rewrite strictE => <-.
 by rewrite nmulr_rlt0.
 Qed.
 
 Lemma under_low_imp_under_high_bis low_e high_e p  :
-~~ (left_pt high_e <<< low_e) ->
-~~ (right_pt high_e <<< low_e) ->
-valid_edge low_e p ->
-valid_edge high_e p ->
-p <<= low_e -> p <<= high_e.
+  ~~ (left_pt high_e <<< low_e) ->
+  ~~ (right_pt high_e <<< low_e) ->
+  valid_edge low_e p ->
+  valid_edge high_e p ->
+  p <<= low_e -> p <<= high_e.
 Proof.
 move : low_e high_e => [ll lr inL] [hl hr inH]  .
 move => pabhl pabhr vallow valhigh.
-have  := exists_point_valid vallow.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx'.
-have  := exists_point_valid valhigh.
-move => [] p'' vip' .
+have [p' vip] := exists_point_valid vallow.
+have := intersection_on_edge vip => [][] poep' eqx'.
+have [p'' vip'] := exists_point_valid valhigh.
 have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
 have := poep''.
 have := poep'.
@@ -1325,29 +1227,25 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => /= puep.
 
-have ydiff : p.y <= p'.y.
-  by rewrite -(under_edge_lower_y eqx' poep').
+have ydiff : p.y <= p'.y by rewrite -(under_edge_lower_y eqx' poep').
 rewrite eqx' in eqx''.
 symmetry in eqx''.
-have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
-have y'diff : p'.y <= p''.y.
-  by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
-have y''diff: (p.y  <= p''.y).
-  by rewrite (le_trans  ydiff y'diff).
+have pabp' := point_on_edge_above  poep'' pabhl pabhr.
+have y'diff : p'.y <= p''.y by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
+have y''diff : p.y  <= p''.y by rewrite (le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
 have /eqP pHleq :=  (area3_vert hl eqx'').
-have /eqP pHreq :=  (area3_vert hr eqx'').
+have pHreq := area3_vert hr eqx''.
 
 rewrite area3_opposite in pHreq.
 rewrite area3_cycle in pHleq.
 
-move : poepf'' pHleq => /eqP  ->  -> .
-have :  area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)).
-  by rewrite -pHreq opprK.
+move : poepf'' pHleq => /eqP  -> /eqP -> .
+have :  area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)) by rewrite -pHreq opprK.
 move => ->.
 rewrite add0r addrC -mulrBl.
-rewrite  [x in (x - _) * _ == _] addrC.
+rewrite [x in (x - _) * _ = _]addrC.
 rewrite addrKA opprK.
 
 rewrite /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
@@ -1355,25 +1253,22 @@ rewrite addrC.
 have inH' := inH.
 rewrite -subr_gte0 in inH'.
 rewrite -subr_le0 in y''diff.
-rewrite underE.
-move => /eqP <-.
+rewrite underE => <-.
 by rewrite pmulr_rle0.
 Qed.
 
 Lemma under_low_imp_strict_under_high_bis low_e high_e p  :
-~~ (left_pt high_e <<< low_e) ->
-~~ (right_pt high_e <<< low_e) ->
-valid_edge low_e p ->
-valid_edge high_e p ->
-p <<< low_e -> p <<< high_e.
+  ~~ (left_pt high_e <<< low_e) ->
+  ~~ (right_pt high_e <<< low_e) ->
+  valid_edge low_e p ->
+  valid_edge high_e p ->
+  p <<< low_e -> p <<< high_e.
 Proof.
 move : low_e high_e => [ll lr inL] [hl hr inH]  .
 move => pabhl pabhr vallow valhigh.
-have  := exists_point_valid vallow.
-move => [] p' vip .
-have  := intersection_on_edge vip => [][] poep' eqx'.
-have  := exists_point_valid valhigh.
-move => [] p'' vip' .
+have [p' vip] := exists_point_valid vallow.
+have := intersection_on_edge vip => [][] poep' eqx'.
+have [ p'' vip'] := exists_point_valid valhigh.
 have  := intersection_on_edge vip' => [][] poep'' eqx''{vip' vip}.
 have := poep''.
 have := poep'.
@@ -1386,30 +1281,28 @@ rewrite -eqx' in linfp' p'infr.
 rewrite -eqx'' in linfp'' p''infr.
 move => /= puep.
 
-have ydiff : p.y < p'.y.
-  by rewrite -(strict_under_edge_lower_y eqx' poep').
+have ydiff : p.y < p'.y by rewrite -(strict_under_edge_lower_y eqx' poep').
 
 rewrite eqx' in eqx''.
 symmetry in eqx''.
-have pabp' := (point_on_edge_above  poep'' pabhl pabhr).
+have pabp' := point_on_edge_above poep'' pabhl pabhr.
 have y'diff : p'.y <= p''.y
    by rewrite leNgt -(strict_under_edge_lower_y eqx'' poep').
-have y''diff: (p.y  < p''.y).
-  by rewrite (lt_le_trans  ydiff y'diff).
+have y''diff : p.y  < p''.y by rewrite (lt_le_trans  ydiff y'diff).
 rewrite -eqx' in eqx''.
 have := ax4_three_triangles p hl hr p''.
 have /eqP pHleq :=  (area3_vert hl eqx'').
-have /eqP pHreq :=  (area3_vert hr eqx'').
+have pHreq :=  (area3_vert hr eqx'').
 
 rewrite area3_opposite in pHreq.
 rewrite area3_cycle in pHleq.
 
-move : poepf'' pHleq => /eqP  ->  -> .
-have :  area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)).
+move : poepf'' pHleq => /eqP  -> /eqP -> .
+have : area3 p p'' hr = - ((p''.x - hr.x) * (p.y - p''.y)).
   by rewrite -pHreq opprK.
 move => ->.
 rewrite add0r addrC -mulrBl.
-rewrite  [x in (x - _) * _ == _] addrC.
+rewrite [x in (x - _) * _ = _]addrC.
 rewrite addrKA opprK.
 
 rewrite /= {pabhl pabhr vallow valhigh poep' poep'' poepf' puep pabp'}.
@@ -1417,8 +1310,7 @@ rewrite addrC.
 have inH' := inH.
 rewrite -subr_gte0 in inH'.
 rewrite -subr_lt0 in y''diff.
-rewrite strictE.
-move => /eqP <-.
+rewrite strictE => <-.
 by rewrite pmulr_rlt0.
 Qed.
 
@@ -1465,7 +1357,7 @@ Qed.
 
 Lemma edge_dir_intersect p1 p2 e1 :
   p1.x != p2.x ->
-  ~~(p1 <<= e1) -> p2 <<< e1 ->
+  ~~ (p1 <<= e1) -> p2 <<< e1 ->
  exists p, area3 p (left_pt e1) (right_pt e1) = 0 /\
       area3 p p1 p2 = 0 /\
    (forall q, area3 q (left_pt e1) (right_pt e1) = 0 ->
@@ -1496,9 +1388,9 @@ have [p [p1 [p2 pu]]] := edge_dir_intersect le2xnre2x ca cu.
 exists p; rewrite p1; split=> //.
 rewrite /point_on_edge p2 eqxx /= /valid_edge.
 rewrite /generic_trajectories.valid_edge.
-have/eqP ol2 := p2.
+have ol2 := p2.
 have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
-rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
+rewrite p1 mulr0 => /esym/eqP; rewrite addrC addr_eq0 -mulNr opprB=> /eqP signcond.
 case : (ltP (p.x) ((right_pt e2).x)).
   move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
   rewrite -(pmulr_lgt0 _ ca') signcond.
@@ -1518,12 +1410,12 @@ have re2xnle2x : (right_pt e2).x != (left_pt e2).x.
   by have := edge_cond e2; rewrite lt_neqAle eq_sym=> /andP[].
 have [p [p1 [p2 pu]]] := edge_dir_intersect re2xnle2x ca cu.
 move: p2; rewrite area3_opposite area3_cycle => /eqP.
-rewrite oppr_eq0=> /[dup] ol2 /eqP p2.
+rewrite oppr_eq0=> /[dup] /eqP ol2 p2.
 exists p; rewrite p1; split=> //.
-rewrite /point_on_edge p2 eqxx /= /valid_edge.
+rewrite /point_on_edge p2/= /valid_edge.
 rewrite /generic_trajectories.valid_edge.
 have := area3_on_edge (left_pt e1) (right_pt e1) ol2 => /=.
-rewrite p1 mulr0 eq_sym addrC addr_eq0 -mulNr opprB=> /eqP signcond.
+rewrite p1 mulr0 => /esym/eqP; rewrite addrC addr_eq0 -mulNr opprB=> /eqP signcond.
 case : (ltP (p.x) ((right_pt e2).x)).
   move=>/[dup]/ltW ->; rewrite andbT -subr_gt0 -subr_le0.
   rewrite -(nmulr_llt0 _ cu') signcond.
@@ -1539,8 +1431,7 @@ Definition lexPt (p1 p2 : pt) : bool :=
 Definition lexePt (p1 p2 : pt) : bool :=
     (p1.x < p2.x) || ((p1.x == p2.x) && (p1.y <= p2.y)).
 
-Lemma lexPtW p1 p2 :
-  lexPt p1 p2 -> lexePt p1 p2.
+Lemma lexPtW p1 p2 : lexPt p1 p2 -> lexePt p1 p2.
 Proof.
 rewrite /lexPt /lexePt =>/orP [-> //=| /andP [] -> y_ineq].
 rewrite ltW //. 
@@ -1631,7 +1522,7 @@ Lemma on_edge_lexePt_left_pt (p : pt) g :
 Proof.
 move=> on.
 have : (left_pt g).x <= p.x by move: on=> /andP[] _ /andP[].
-rewrite le_eqVlt=> /orP[/eqP/esym /[dup] samex' /eqP samex | xlt ].
+rewrite le_eqVlt=> /orP[/eqP/esym /[dup] samex' samex | xlt ].
  have/eqP samey := on_edge_same_point on (left_on_edge _) samex.
   have -> : p = left_pt g.
     by apply/eqP; rewrite pt_eqE samex' samey !eqxx.
@@ -1652,14 +1543,14 @@ move: cpa cpb cpc; rewrite dp d'p d''p {dp d'p d''p}.
 case: p=> [px py]; simpl p_x; simpl p_y=> cpa cpb cpc.
 move=> c1' c2'.
 have c1 : 0 <= pue_f px py a_x a_y b_x b_y.
-  move: c1'; rewrite !(eqP (pue_f_eq _ _ _ _)) lexx ltxx !andTb -leNgt.
+  move: c1'; rewrite !(pue_f_eq _ _ _ _) lexx ltxx !andTb -leNgt.
   by rewrite pue_f_o oppr_lte0 (pue_f_c px)=> /orP[].
 have c2 : 0 <= pue_f px py b_x b_y c_x c_y.
-  move: c2'; rewrite !(eqP (pue_f_eq _ _ _ _)) lexx ltxx !andTb -leNgt.
+  move: c2'; rewrite !(pue_f_eq _ _ _ _) lexx ltxx !andTb -leNgt.
   by rewrite pue_f_o oppr_lte0 (pue_f_c px)=> /orP[].
 move=> {c1' c2'}.
 apply/orP; left.
-rewrite (eqP (pue_f_eq _ _ _ _)) lexx andTb pue_f_o -pue_f_c oppr_lte0.
+rewrite (pue_f_eq _ _ _ _) lexx andTb pue_f_o -pue_f_c oppr_lte0.
 set p := Bpt px py.
 have aright : 0 < area3 p (subpoint p) (Bpt a_x a_y).
   by apply: point_sub_right.
@@ -1690,8 +1581,9 @@ have dify : ((left_pt e1 <<< e2) \/ (~~(left_pt e1 <<= e2))) -> (left_pt e1).y !
   by move: disj; rewrite under_onVstrict // strict_nonAunder // -A pone2; case.
 have pone2'': pue_f ((left_pt e2).x) ((left_pt e2).y)
              ((right_pt e2).x) ((right_pt e2).y)
-             (p.x) (p.y) == 0.
-  by rewrite -pue_f_c; move: pone2'; rewrite area3E pue_f_c.
+             (p.x) (p.y) = 0.
+  rewrite -pue_f_c; move: pone2'; rewrite area3E pue_f_c.
+  by move/eqP.
 move: (edge_cond e2); rewrite -(subr_gt0 (_.x))=> ce2.
 have dife2 : 0 < (right_pt e2).x - (left_pt e2).x.
   by move: (edge_cond e2); rewrite -(subr_gt0 (_.x)).
@@ -1699,11 +1591,11 @@ have dife2' : (right_pt e2).x - (left_pt e2).x != 0.
   by move: dife2; rewrite  lt_neqAle eq_sym=> /andP[].
 have plp2 : (left_pt e2).x = (left_pt e1).x -> p = left_pt e2.
   move=> c; have:= on_edge_same_point pone2 (left_on_edge _).
-  rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
+  rewrite c px => /(_ erefl); move: px c.
   by case: (p) (left_pt e2)=> [? ?][? ?]/= <- <- ->.
 have prp2 : (right_pt e2).x = (left_pt e1).x -> p = right_pt e2.
   move=> c; have:= on_edge_same_point pone2 (right_on_edge _).
-  rewrite c px eqxx=> /(_ isT)=> /eqP; move: px c.
+  rewrite c px => /(_ erefl); move: px c.
   by case: (p) (right_pt e2)=> [? ?][? ?]/= <- <- ->.
 have main : (0 < area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
        (p.y < (left_pt e1).y).
@@ -1713,7 +1605,7 @@ have main : (0 < area3 (left_pt e1) (left_pt e2) (right_pt e2)) =
     by rewrite -atleft pisl (edge_cond e2).
   have fact1 : (0 < p.x - (left_pt e2).x) by rewrite subr_gt0 -px.
   rewrite -(pmulr_rgt0 _ fact1) area3_opposite mulrN.
-  rewrite -(eqP (area3_triangle_on_edge (left_pt e1) pone2')) -mulrN.
+  rewrite -(area3_triangle_on_edge (left_pt e1) (eqP pone2')) -mulrN.
   rewrite -area3_opposite area3_cycle pmulr_rgt0 //.
   by apply: edge_and_right_vertical; rewrite -px.
 have arith : forall (a b : R), a <= 0 -> b <= 0 -> a + b <= 0.
@@ -1729,7 +1621,7 @@ have case1 : left_pt e1 <<< e2 -> e1 <| e2.
   have : 0 < area3 p (left_pt e1) (right_pt e1).
     by rewrite edge_and_left_vertical // -px (edge_cond e1).
   rewrite -(pmulr_rgt0 _ ce2).
-  rewrite (eqP (area3_on_edge (left_pt e1) (right_pt e1) pone2')).
+  rewrite (area3_on_edge (left_pt e1) (right_pt e1) (eqP pone2')).
   rewrite ltNge arith //.
     apply: mulr_ge0_le0; first by rewrite -px subr_ge0.
     by move: re2b; rewrite underE -area3_cycle.
@@ -1746,7 +1638,7 @@ have : 0 < area3 (left_pt e1) p (right_pt e1).
   by rewrite edge_and_left_vertical // (edge_cond e1).
 rewrite area3_opposite -area3_cycle.
 rewrite -(pmulr_rgt0 _ dife2) mulrN.
-move: (eqP (area3_on_edge (left_pt e1) (right_pt e1) pone2')) => ->.
+rewrite (area3_on_edge (left_pt e1) (right_pt e1) (eqP pone2')).
 by rewrite oppr_gt0 ltNge addr_ge0 // mulr_ge0 // -px subr_ge0.
 Qed.
 
@@ -1759,8 +1651,8 @@ move=> nc e1 e2 e1in e2in.
 have nc' := inter_at_ext_sym nc.
 have ceq : e1 = e2 -> below_alt e1 e2.
   move=> <-; left; apply/orP; left; rewrite !underE.
-  rewrite (fun a b => eqP (proj1 (area3_two_points a b))).
-  rewrite (fun a b => eqP (proj1 (proj2 (area3_two_points a b)))).
+  rewrite (fun a b => proj1 (area3_two_points a b)).
+  rewrite (fun a b => proj1 (proj2 (area3_two_points a b))).
   by rewrite lexx.
 have [/eqP/ceq // | e1ne2] := boolP(e1 == e2).
 have [/eqP | {}nc ] := nc _ _ e1in e2in; first by rewrite (negbTE e1ne2).
@@ -1876,9 +1768,9 @@ Lemma common_point_edges_y_left r r1 r2 e1 e2 :
 Proof.
 move=> v xl rr1 rr2 e1e2 re1 re2.
 have xl': r.x = (left_pt e1).x by apply: le_anti; rewrite xl; case/andP:v.
-have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
+have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 => /(_ erefl) <-.
 have:= on_edge_same_point (left_on_edge _) re1.
-by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
+by rewrite -xl' rr1 =>/(_ erefl) <-.
 Qed.
 
 Lemma common_point_edges_y_right r r1 r2 e1 e2 :
@@ -1890,9 +1782,9 @@ Proof.
 move=> v xl rr1 rr2 e1e2 re1 re2.
 have xl': r.x = (right_pt e1).x.
   by apply: le_anti; rewrite xl andbC; case/andP:v.
-have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 eqxx=> /(_ isT)/eqP <-.
+have:= on_edge_same_point e1e2 re2; rewrite -xl' rr2 => /(_ erefl) <-.
 have:= on_edge_same_point (right_on_edge _) re1.
-  by rewrite -xl' rr1 eqxx=>/(_ isT)/eqP<-.
+  by rewrite -xl' rr1 =>/(_ erefl) <-.
 Qed.
 
 Lemma expand_valid p q (pq : p.x < q.x) e r :
@@ -1932,22 +1824,22 @@ have yq : q1.y < q2.y by rewrite (le_lt_trans qyge).
 move=> {pyge qyge pylt qylt abbrev}.
 have [/[dup]p1p2 + /[dup] q1q2 +] : [/\ p1.x == p2.x & q1.x == q2.x].
   by rewrite -p1p p2p -q1q q2q !eqxx.
-move=>/eqP/esym/eqP p2p1 /eqP/esym/eqP q2q1.
+move=>/eqP/esym p2p1 /eqP/esym q2q1.
 move: (pone1) (pone2) (qone1) (qone2).
-move=>/andP[]pl1 _ /andP[]pl2 _ /andP[]ql1 _ /andP[] ql2 _.
+move=>/andP[/eqP pl1 _] /andP[/eqP pl2 _] /andP[/eqP ql1 _] /andP[/eqP ql2 _].
 have [pltq | qltp | pq ] := ltrgtP (p.x) (q.x).
 - have [p1q1 p2q2] : p1.x < q1.x /\ p2.x < q2.x.
     by rewrite -p1p -q1q -p2p -q2q .
   set e3 := Bedge p1q1; set e4 := Bedge p2q2.
-  have l3a : ~~(left_pt e3 <<= e4).
-    by move/(@pue_left_edge e4):p2p1=> -> /=; rewrite subr_ge0 -ltNge.
+  have l3a : ~~ (left_pt e3 <<= e4).
+    by move/(@pue_left_edge e4) : p2p1 => -> /=; rewrite subr_ge0 -ltNge.
   have r3u : right_pt e3 <<< e4.
-    by move/(@psue_right_edge e4):q2q1=> -> /=; rewrite subr_lt0.
+    by move/(@psue_right_edge e4) : q2q1 => -> /=; rewrite subr_lt0.
   have [pi [pi4 /andP[pi3 piint]]] := intersection_middle_au l3a r3u.
   have pi1 : pi === e1.
     apply/andP; split; last first.
-      apply: (expand_valid piint);
-        by rewrite /valid_edge/generic_trajectories.valid_edge -?p1p -?q1q.
+      by apply: (expand_valid piint);
+        rewrite /valid_edge/generic_trajectories.valid_edge -?p1p -?q1q.
     rewrite -sgr_eq0 (area3_change_ext _ (edge_cond e1) p1q1) //.
     by rewrite (eqP pi3) /sg !eqxx.
   have pi2 : pi === e2.
@@ -1995,7 +1887,7 @@ have [pltq | qltp | pq ] := ltrgtP (p.x) (q.x).
   have abs := right_ext _ _ _ vp1 pip p1p p2p pi2 pone1 pone2.
   by move: yp; rewrite abs ltxx.
 have := conj (on_edge_same_point pone1 qone1) (on_edge_same_point pone2 qone2).
-rewrite -p1p -p2p pq q1q q1q2 !eqxx=> -[]/(_ isT)/eqP p1q1 /(_ isT)/eqP p2q2.
+rewrite -p1p -p2p pq q1q (eqP q1q2) => -[]/(_ erefl) p1q1 /(_ erefl) p2q2.
 by move: yp; rewrite p1q1 p2q2; rewrite ltNge le_eqVlt yq orbT.
 Qed.
 
@@ -2026,7 +1918,7 @@ Qed.
 Definition on_pvert p e : p === e -> pvert_y p e = p.y.
 Proof.
 move=> /[dup]/andP[] _ vpe pone.
-by have := on_edge_same_point pone (pvert_on vpe) (eqxx _) => /eqP ->.
+by rewrite (on_edge_same_point pone (pvert_on vpe)).
 Qed.
 
 Definition cmp_slopes e1 e2 :=
@@ -2049,9 +1941,9 @@ Lemma same_left_edge_below_slopes e1 e2 :
 Proof.
 move=> sameleft.
 rewrite /edge_below !underE [in X in X || _]sameleft.
-rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
+rewrite (proj1 (area3_two_points _ _)) lexx /=.
 rewrite !strictE -[in X in _ || X]sameleft -!leNgt.
-rewrite (eqP (proj1 (area3_two_points _ _))) lexx /=.
+rewrite (proj1 (area3_two_points _ _)) lexx /=.
 rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
 rewrite  /cmp_slopes sameleft -opprB oppr_le0.
 rewrite [X in (_ <= X - _) || _]mulrC.
@@ -2066,9 +1958,9 @@ Lemma same_right_edge_below_slopes e1 e2 :
 Proof.
 move=> sameright.
 rewrite /edge_below !underE [in X in X || _]sameright.
-rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /=.
+rewrite (proj1 (proj2 (area3_two_points _ _))) lexx /=.
 rewrite !strictE -[in X in _ || X]sameright -!leNgt.
-rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx /= !andbT.
+rewrite (proj1 (proj2 (area3_two_points _ _))) lexx /= !andbT.
 rewrite !area3E !(proj2 (pue_f_eq_slopes _ _ _ _ _ _)).
 rewrite /cmp_slopes sameright oppr_le0 opprB.
 rewrite !(mulrC ((right_pt e2).y - _)) orbb.
@@ -2170,7 +2062,7 @@ move: (val) => /andP[] _; rewrite le_eqVlt=> /orP[/eqP atr | le1ltre2].
   rewrite /cmp_slopes atr.
   have eqps : left_pt e1 = right_pt e2.
     have := on_edge_same_point (right_on_edge _) on2.
-    rewrite atr eqxx => /(_ isT) /eqP; move: (right_pt e2) (left_pt e1) atr.
+    rewrite atr => /(_ erefl); move: (right_pt e2) (left_pt e1) atr.
     by move=> [] ? ? [] ? ? /= -> ->.
   rewrite area3_opposite area3_cycle.
   rewrite sgrN.
@@ -2180,7 +2072,7 @@ move: (val) => /andP[] _; rewrite le_eqVlt=> /orP[/eqP atr | le1ltre2].
   by rewrite mulrN mulNr -opprD opprB.
 set e2' := Bedge le1ltre2.
 have signcond := area3_change_ext (right_pt e1) (edge_cond e2) le1ltre2
-             form (proj1 (proj2 (area3_two_points _ _))).
+             (eqP form) (proj1 (proj2 (area3_two_points _ _))).
 rewrite {}signcond.
 have on2' : left_pt e2' === e2 by exact: on2.
 rewrite cmp_slopesE  -(on_edge_same_slope_right on2')// -cmp_slopesE.
@@ -2205,7 +2097,7 @@ move: (val) => /andP[] + _; rewrite le_eqVlt eq_sym=> /orP[/eqP atl | le2ltre1].
   rewrite /cmp_slopes atl.
   have eqps : right_pt e1 = left_pt e2.
     have := on_edge_same_point (left_on_edge _) on2.
-    rewrite atl eqxx => /(_ isT) /eqP; move: (right_pt e1) (left_pt e2) atl.
+    rewrite atl => /(_ erefl); move: (right_pt e1) (left_pt e2) atl.
     by move=> [] ? ? [] ? ? /= -> ->.
   rewrite !area3E !(proj1 (pue_f_eq_slopes _ _ _ _ _ _)).
   rewrite eqps (mulrC (_.x - _)).
@@ -2213,7 +2105,7 @@ move: (val) => /andP[] + _; rewrite le_eqVlt eq_sym=> /orP[/eqP atl | le2ltre1].
   by rewrite mulrN mulNr -opprD opprB.
 set e2' := Bedge le2ltre1.
 have signcond := area3_change_ext (left_pt e1) (edge_cond e2) le2ltre1
-             (proj1 (area3_two_points _ _)) form.
+             (proj1 (area3_two_points _ _)) (eqP form).
 rewrite {}signcond.
 have on2' : right_pt e2' === e2 by exact: on2.
 rewrite cmp_slopesE  -(on_edge_same_slope_left on2')// -cmp_slopesE.
@@ -2321,11 +2213,11 @@ have pp : p1 = p2 by rewrite p1q p2q vyq.
 move: (ve1) => /andP[] + _; rewrite le_eqVlt=>/orP[/eqP pleft | pmid] /=.
   have p1l : p1 = left_pt e1.
     apply/esym/eqP; rewrite pt_eqE.
-    by rewrite (on_edge_same_point (left_on_edge _) on1) pleft p1q eqxx.
+    by rewrite (on_edge_same_point (left_on_edge _) on1) pleft p1q// eqxx andbT.
   move: ve2 => /andP[] + _; rewrite le_eqVlt=> /orP [/eqP pleft2 | pmid2].
     have p2l : p2 = left_pt e2.
       apply/esym/eqP; rewrite pt_eqE.
-      by rewrite (on_edge_same_point (left_on_edge _) on2) pleft2 p2q eqxx.
+      by rewrite (on_edge_same_point (left_on_edge _) on2) pleft2 p2q// eqxx andbT.
     by apply: same_left_edge_below_slopes; rewrite -p1l pp.
   have le2ltp2 : (left_pt e2).x < p2.x by rewrite p2q.
   have [e2' [le2' re2' sle2']] := sub_edge_left on2 le2ltp2.
@@ -2363,7 +2255,7 @@ rewrite le_eqVlt eq_sym -Weq (negbTE difslope) /=.
 move: (ve2) => /andP[] + _; rewrite le_eqVlt => /orP [/eqP l2p | l2ltp].
   have /eqP p2l : left_pt e2 == p1.
     rewrite pt_eqE.
-    rewrite (eqP (on_edge_same_point (left_on_edge _) on2 _)) -pp l2p p1q //=.
+    rewrite (on_edge_same_point (left_on_edge _) on2 _) -pp l2p p1q //=.
     by rewrite !eqxx.
   have/contact_left_slope[_ eq3] : left_pt e2 === e1 by rewrite p2l.
   move: on1=>/andP[] /eqP + _; rewrite -p2l => eq4.
@@ -2407,11 +2299,11 @@ have pp : p1 = p2 by rewrite p1q p2q vyq.
 move: (ve1) => /andP[] _ +; rewrite le_eqVlt=>/orP[/eqP pright | pmid] /=.
   have p1r : p1 = right_pt e1.
     apply/eqP; rewrite pt_eqE.
-    by rewrite (on_edge_same_point on1 (right_on_edge _)) -pright p1q eqxx.
+    by rewrite (on_edge_same_point on1 (right_on_edge _)) -pright p1q// eqxx andbT.
   move: ve2 => /andP[] _; rewrite le_eqVlt=> /orP [/eqP pright2 | pmid2].
     have p2l : p2 = right_pt e2.
       apply/eqP; rewrite pt_eqE.
-      by rewrite (on_edge_same_point on2 (right_on_edge _)) -pright2 p2q eqxx.
+      by rewrite (on_edge_same_point on2 (right_on_edge _)) -pright2 p2q// eqxx andbT.
     by apply: same_right_edge_below_slopes; rewrite -p1r pp.
   have p2ltre2 : p2.x < (right_pt e2).x by rewrite p2q.
   have [e2' [le2' re2' sle2']] := sub_edge_right on2 p2ltre2.
@@ -2449,7 +2341,7 @@ rewrite le_eqVlt -Weq (negbTE difslope) /=.
 move: (ve2) => /andP[] _; rewrite le_eqVlt => /orP [/eqP r2p | pltr2].
   have /eqP p2r : right_pt e2 == p1.
     rewrite pt_eqE.
-    rewrite -(eqP (on_edge_same_point on2 (right_on_edge _) _)) -pp -r2p p1q //=.
+    rewrite -(on_edge_same_point on2 (right_on_edge _) _) -pp -r2p p1q //=.
     by rewrite !eqxx.
   have/contact_right_slope[_ eq3] : right_pt e2 === e1 by rewrite p2r.
   move: on1=>/andP[] /eqP + _; rewrite -p2r => eq4.
@@ -2507,31 +2399,17 @@ rewrite (edge_below_equiv' valb noc) //.
 by apply: pedge_below_trans'.
 Qed.
 
-
 Lemma left_pt_above g : left_pt g >>= g.
-Proof.
-rewrite strictE.
-rewrite (eqP (proj1 (area3_two_points _ _))).
-by rewrite ltxx.
-Qed.
+Proof. by rewrite strictE (proj1 (area3_two_points _ _)) ltxx. Qed.
 
 Lemma right_pt_above g : right_pt g >>= g.
-Proof.
-rewrite strictE.
-by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) ltxx.
-Qed.
+Proof. by rewrite strictE (proj1 (proj2 (area3_two_points _ _))) ltxx. Qed.
 
 Lemma left_pt_below g : left_pt g <<= g.
-Proof.
-rewrite underE (eqP (proj1 (area3_two_points _ _))).
-by rewrite lexx.
-Qed.
+Proof. by rewrite underE (proj1 (area3_two_points _ _)) lexx. Qed.
 
 Lemma right_pt_below g : right_pt g <<= g.
-Proof.
-rewrite underE.
-by rewrite (eqP (proj1 (proj2 (area3_two_points _ _)))) lexx.
-Qed.
+Proof. by rewrite underE (proj1 (proj2 (area3_two_points _ _))) lexx. Qed.
 
 Lemma under_pvert_y (p : pt) (e : edge) :
   valid_edge e p -> (p <<= e) = (p.y <= pvert_y p e).
@@ -2552,18 +2430,17 @@ by rewrite (strict_under_edge_lower_y xs one).
 Qed.
 
 Lemma same_x_valid (p1 p2 : pt) (g : edge) :
-  p1.x == p2.x -> valid_edge g p1 = valid_edge g p2.
+  p1.x = p2.x -> valid_edge g p1 = valid_edge g p2.
 Proof.
-by move=> /eqP xs; rewrite /valid_edge/generic_trajectories.valid_edge xs.
+by move=> xs; rewrite /valid_edge /generic_trajectories.valid_edge xs.
 Qed.
 
 Lemma same_pvert_y (p1 p2 : pt) (g : edge) :
-  valid_edge g p1 ->
-  p1.x == p2.x -> pvert_y p1 g = pvert_y p2 g.
+  valid_edge g p1 -> p1.x = p2.x -> pvert_y p1 g = pvert_y p2 g.
 Proof.
-move=> vg xs; apply/eqP.
+move=> vg xs.
 move: (vg) ; rewrite (same_x_valid _ xs) => vg2.
-by have := on_edge_same_point (pvert_on vg) (pvert_on vg2) xs.
+exact: (on_edge_same_point (pvert_on vg) (pvert_on vg2) xs).
 Qed.
 
 Lemma edge_below_pvert_y g1 g2 p :
@@ -2572,11 +2449,11 @@ Lemma edge_below_pvert_y g1 g2 p :
 Proof.
 move=> v1 v2 g1g2.
 have := pvert_on v1; set p' := Bpt _ _ => p'on.
-have/esym := @same_x_valid p p' g1 (eqxx _); rewrite v1 => v'1.
-have/esym := @same_x_valid p p' g2 (eqxx _); rewrite v2 => v'2.
+have/esym := @same_x_valid p p' g1 erefl; rewrite v1 => v'1.
+have/esym := @same_x_valid p p' g2 erefl; rewrite v2 => v'2.
 have := order_edges_viz_point' v'1 v'2 g1g2.
 rewrite (under_onVstrict v'1) p'on => /(_ isT).
-by rewrite under_pvert_y //.
+by rewrite under_pvert_y.
 Qed.
 
 Lemma pvert_y_edge_below g1 g2 p :
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index 6f65f4b..59d50d8 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -201,8 +201,8 @@ do 5 move=> /andP[] _.
 move=> /andP[] rn0 /andP[] rsx /andP[] srt /andP[] _ lon.
 have p'q : p' = last dummy_pt (right_pts c).
   have := on_edge_same_point p'on lon.
-  rewrite (allP rsx _ pin)=> /(_ isT)=> samey.
-  by apply/(@eqP pt); rewrite pt_eqE samey (allP rsx _ pin).
+  have /eqP -> := allP rsx _ pin => /(_ erefl) samey.
+  by apply/(@eqP pt); rewrite pt_eqE samey (allP rsx _ pin)/=; exact/eqP.
 move: rn0 p'q pin srt.
 elim/last_ind: (right_pts c) => [| rpts p2 Ih] // _ p'q pin srt.
 move: pin; rewrite mem_rcons inE => /orP[/eqP -> | pin].
@@ -243,9 +243,9 @@ move=> /andP[] ln0 /andP[] lsx /andP[] srt /andP[] hon _.
 have p'q : p' = head dummy_pt (left_pts c).
   have := on_edge_same_point p'on hon.
   rewrite (eqP (allP lsx _ pin)).
-  rewrite (x_left_pts_left_limit cok (head_in_not_nil _ ln0)) eqxx.
-  move=> /(_ isT)=> samey.
-  apply/(@eqP pt); rewrite pt_eqE samey andbT.
+  rewrite (x_left_pts_left_limit cok (head_in_not_nil _ ln0)).
+  move=> /(_ erefl) samey.
+  apply/(@eqP pt); rewrite pt_eqE samey eqxx andbT.
   rewrite (eqP (allP lsx _ pin)) eq_sym.
   by rewrite (allP lsx _ (head_in_not_nil _ ln0)).
 move: ln0 p'q pin srt.
@@ -275,10 +275,10 @@ have : left_limit pc1 <= p_x p.
   by move:(pong)=> /andP[] _ /andP[]; rewrite lpcc.
 rewrite le_eqVlt=> /orP[ /eqP pxq | ].
   have plg : p = left_pt g.
-    move: lpcc; rewrite /= pxq=> /eqP samex.
+    move: lpcc; rewrite /= pxq=> samex.
     have := on_edge_same_point pong (left_on_edge _).
-    rewrite samex=> /(_ isT) samey.
-    by apply/(@eqP pt); rewrite pt_eqE samex samey.
+    rewrite samex=> /(_ erefl) samey.
+    by apply/(@eqP pt); rewrite pt_eqE samex samey !eqxx.
   have pin : p \in points.
     apply: obstacles_point_in; rewrite mem_cat; apply/orP; left.
     by rewrite plg map_f.
@@ -306,7 +306,7 @@ rewrite le_eqVlt=> /orP[ /eqP pxq | ].
   by rewrite prlq le_refl andbT (non_empty_closed ccl').
 elim: pcc pc1 pcccl highs conn rpcc {lpcc pccn0} =>
   [ | pc2 pcc Ih] pc1 pcccl highs conn rpcc pc1lp.
-  have pc1cl : pc1 \in closed by apply: pcccl; rewrite inE eqxx.  
+  have pc1cl : pc1 \in closed by apply: pcccl; rewrite inE eqxx.
   have hpc1 : high pc1 = g by apply: (highs _ (mem_head _ _)).
   move: rpcc; rewrite /last_cell/= => rpc1.
   have vgp : valid_edge g p by move: pong=> /andP[].
@@ -334,9 +334,10 @@ elim: pcc pc1 pcccl highs conn rpcc {lpcc pccn0} =>
     noc1 (closed_ok pc1cl) _ ponh; apply.
     rewrite pc1lp /= rpc1.
     move: (pong)=> /andP[] _ /andP[] _; rewrite le_eqVlt=> /orP[]; last by [].
-    move=> abs.
+    move=> /eqP abs.
     move: pnr=> /negP[]; rewrite pt_eqE abs /=.
-    by have := on_edge_same_point pong (right_on_edge _) abs.
+    rewrite (on_edge_same_point pong (right_on_edge _)) -abs//.
+    by rewrite !eqxx.
   have vph1 : valid_edge (high pc1) p by move: ponh=> /andP[].
   have [cqc' | ] := disj_closed ccl pc1cl.
     by move: puh; rewrite strict_nonAunder cqc' // ponh.

From 96e7b3a8257e27c03b182f97f7bd2c0d0584fb38 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 30 Apr 2024 16:33:36 +0200
Subject: [PATCH 26/43] reinstate the separation between the abstract
 presentation of shortest_path and the rest of generic_trajectories.  adds a
 new function to be extracted so that we can visualize the piecewise linear
 trajectory

---
 _CoqProject                     |   1 +
 theories/generic_trajectories.v | 173 ++++++++++----------
 theories/shortest_path.v        | 273 +++++++++++---------------------
 theories/smooth_trajectories.v  |   4 +
 www/Makefile.coq.local          |   2 +-
 5 files changed, 190 insertions(+), 263 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index a923345..73b65ce 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -1,3 +1,4 @@
+theories/shortest_path.v
 theories/generic_trajectories.v
 theories/smooth_trajectories.v
 theories/convex.v
diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 28a29b6..ab59cc9 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -1,5 +1,6 @@
 From mathcomp Require Import all_ssreflect.
 Require Import ZArith (* List *) String OrderedType OrderedTypeEx FMapAVL.
+Require Import shortest_path.
 
 Notation head := seq.head.
 Notation sort := path.sort.
@@ -432,63 +433,6 @@ Definition edges_to_cells bottom top edges :=
 (* To compute a path that has reasonable optimzation, we compute a shortest *)
 (* path between reference points chosen inside doors. *)
 
-Section shortest_path.
-
-Variable cell : Type.
-Variable node : Type.
-Variable node_eqb : node -> node -> bool.
-Variable neighbors_of_node : node -> seq (node * R).
-Variable source target : node.
-
-Definition gpath := seq node.
-Variable priority_queue : Type.
-Variable empty : priority_queue.
-Variable gfind : priority_queue -> node -> option (gpath * option R).
-Variable update : priority_queue -> node -> gpath -> option R -> priority_queue.
-Variable pop :  priority_queue -> option (node * gpath * option R * priority_queue).
-
-Definition cmp_option (v v' : option R) :=
-  if v is Some x then
-    if v' is Some y then
-       (R_ltb x y)%O
-    else
-      true
-   else
-     false.
-
-Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
-  (q : priority_queue) : priority_queue :=
-  let neighbors := neighbors_of_node d in
-  foldr (fun '(d', dist') q =>
-           match gfind q d' with
-           | None => q
-           | Some (p', o_dist) =>
-             let new_dist_to_d' := Some (R_add dist dist') in
-             if cmp_option new_dist_to_d' o_dist then
-                update q d' (d :: p) new_dist_to_d'
-             else q
-           end) q neighbors.
-
-Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
-  match fuel with
-  | 0%nat => None
-  |S fuel' =>
-    match pop q with
-    | Some (d, p, Some dist, q') =>
-      if node_eqb d target then Some p else
-        Dijkstra fuel' (Dijkstra_step d p dist q')
-    | _ => None
-    end
-  end.
-
-Definition shortest_path (s : seq node) :=
-  Dijkstra (size s)
-    (update (foldr [fun n q => update q n [::] None] empty s)
-        source [::] (Some R0)).
-
-End shortest_path.
-
-
 (* defining the connection relation between adjacent cells.  Two cells
   are adjacent when it is possible to move from one cell directly to the
   other without colliding an obstacle edge.  In the data structure, it means
@@ -501,6 +445,9 @@ Definition vert_edge_eqb (v1 v2 : vert_edge) :=
   let: Build_vert_edge v2x v2t v2b := v2 in
   R_eqb v1x v2x && R_eqb v1t v2t && R_eqb v1b v2b.
 
+(* the lists of points left_pts and right_pts for each cell define the
+  extremities of the doors, but we wish to have a list of all doors,
+  obtained by making intervals between two points. *)
 Fixpoint seq_to_intervals_aux [A : Type] (a : A) (s : seq A) :=
 match s with
 | nil => nil
@@ -524,9 +471,19 @@ Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p)))
    (seq_to_intervals (rev (right_pts c))).
 
+(* The index_seq function is a trick to circumvent the absence of a mapi
+  function in Coq code.  It makes it possible to build a list of pairs,
+  where each element is annotated with its position in the list. *)
 Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
   zip (iota 0 (size s)) s.
 
+(* Given a set of cells (given as a sequence), we wish to construct all
+  the vertical edges (called doors) connecting two cells, and we wish each
+  door to contain information about the cells they are connected to, here
+  their rank in the sequence of cells. *)
+
+Definition door := (vert_edge * nat * nat)%type.
+
 Definition cells_to_doors (s : list cell) :=
   let indexed_s := index_seq s in
   let vert_edges_and_right_cell :=
@@ -549,13 +506,17 @@ Definition on_vert_edge (p : pt) (v : vert_edge) : bool :=
 Definition vert_edge_midpoint (ve : vert_edge) : pt :=
   {|p_x := ve_x ve; p_y := R_div ((R_add (ve_top ve) (ve_bot ve))) R2|}.
  
+(* When a vertical edge contains the source or the target, we wish this
+  point to be considered as the reference point for that edge. *)
 Definition vert_edge_to_reference_point (s t : pt) (v : vert_edge) :=
   if on_vert_edge s v then s
   else if on_vert_edge t v then t
   else vert_edge_midpoint v.
 
-Definition door := (vert_edge * nat * nat)%type.
-
+(* Each door has one or two neighboring cells, the neighboring doors
+  are those doors that share one of these neighboring cells.  Here we only
+  want to know the index of the neighbors.  We make sure to avoid including
+  the current door in the neighbors. *)
 Definition one_door_neighbors
   (indexed_doors : seq (nat * door))
   (i_d : nat * door) : list nat :=
@@ -571,12 +532,19 @@ Definition left_limit (c : cell) := p_x (seq.last dummy_pt (left_pts c)).
 
 Definition right_limit c := p_x (seq.last dummy_pt (right_pts c)).
 
+Definition cmp_option := cmp_option _ R_ltb.
+
 Definition strict_inside_closed p c :=
   negb (point_under_edge p (low c)) &&
   point_strictly_under_edge p (high c) &&
  (R_ltb (left_limit c) (p_x p) &&
  (R_ltb (p_x p) (right_limit c))).
 
+(* For each extremity, we check whether it is already inside an existing
+  door.  If it is the case, we need to remember the index of that door.
+  If the extremity is not inside a door, then we create a fictitious door,
+  where the neighboring cells both are set to the one cell containing this
+  point. *)
 Definition add_extremity_reference_point
   (indexed_cells : seq (nat * cell))
   (p : pt) (doors : seq door) :=
@@ -590,6 +558,10 @@ Definition add_extremity_reference_point
         (filter (fun '(i', c') => strict_inside_closed p c')  indexed_cells) in
       (rcons doors ({|ve_x := p_x p; ve_top := p_y p; ve_bot := p_y p|}, i, i), size doors).
 
+(* This function makes sure that the sequence of doors contains a door
+  for each of the extremities, adding new doors when needed.  It returns
+  the updated sequence of doors and the indexes for the doors containing
+  each of the extremities. *)
 Definition doors_and_extremities (indexed_cells : seq (nat * cell))
   (doors : seq door) (s t : pt) : seq door * nat * nat :=
   let '(d_s, i_s) :=
@@ -598,6 +570,8 @@ Definition doors_and_extremities (indexed_cells : seq (nat * cell))
      add_extremity_reference_point indexed_cells t d_s in
   (d_t, i_s, i_t).
 
+(* In the end the door adjacency map describes the graph in which we
+  want to compute paths. *)
 Definition door_adjacency_map (doors : seq door) :
   seq (seq nat) :=
   let indexed_doors := index_seq doors in
@@ -608,6 +582,10 @@ Definition dummy_vert_edge :=
 
 Definition dummy_door := (dummy_vert_edge, 0, 0).
 
+(* To compute the distance between two doors, we compute the distance
+  between the reference points. TODO: this computation does not take
+  into account the added trajectory to go to a safe point inside the
+  cell where the doors are vertically aligned.  *)
 Definition distance (doors : seq door) (s t : pt) 
   (i j : nat) :=
   let '(v1, _, _) := seq.nth dummy_door doors i in
@@ -616,6 +594,8 @@ Definition distance (doors : seq door) (s t : pt)
   let p2 := vert_edge_to_reference_point s t v2 in
   pt_distance (p_x p1) (p_y p1) (p_x p2) (p_y p2).
 
+(* The function cells_too_doors_graph constructs the graph with
+  weighted edges. *)
 Definition cells_to_doors_graph (cells : seq cell) (s t : pt) :=
   let regular_doors := cells_to_doors cells in
   let indexed_cells := index_seq cells in
@@ -627,20 +607,28 @@ Definition cells_to_doors_graph (cells : seq cell) (s t : pt) :=
         | '(i, neighbors) <- index_seq adj_map] in
       (full_seq_of_doors, neighbors_and_distances, i_s, i_t).
 
+(* We can now call the shortest path algorithm, where the nodes are
+  door indices. *)
 Definition node := nat.
 
-Definition empty := @nil (node * gpath node * option R).
+Definition empty := @nil (node * seq node * option R).
 
-Notation priority_queue := (list (node * gpath node * option R)).
+(* The shortest graph algorithm relies on a priority queue.  We implement
+  such a queue by maintaining a sorted list of nodes. *)
+Notation priority_queue := (list (node * seq node * option R)).
 
 Definition node_eqb := Nat.eqb.
 
+(* To find a element in the priority queue, we just traverse the list
+  until we find one node that that the same index. *)
 Fixpoint gfind (q : priority_queue) n :=
   match q with
   | nil => None
   | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else gfind tl n
   end.
 
+(* To remove an element, we traverse the list.  Note that we only remove
+  the first instance. *)
 Fixpoint remove (q : priority_queue) n :=
   match q with
   | nil => nil
@@ -651,6 +639,8 @@ Fixpoint remove (q : priority_queue) n :=
       (n', p', d') :: remove tl n
   end.
 
+(* To insert a new association in the priority queue, we are careful to
+  insert the node in the right place comparing the order. *)
 Fixpoint insert (q : priority_queue) n p d :=
   match q with
   | nil => (n, p, d) :: nil
@@ -665,22 +655,31 @@ Definition update q n p d :=
   insert (remove q n) n p d.
 
 Definition pop  (q : priority_queue) :
-   option (node * gpath node * option R * priority_queue) :=
+   option (node * seq node * option R * priority_queue) :=
   match q with
   | nil => None
   | v :: tl => Some (v, tl)
   end.
 
+(* This function takes as input the sequence of cells, the source and
+  target points.  It returns a tuple containing:
+  - the graph of doors,
+      this graph is a sequence of pairs, where the first component is
+         is door, and the second component is the sequence of nodes
+  - the path, when it exists,
+  - the index of the doors containing the source and targt points *)
 Definition c_shortest_path cells s t :=
   let '(adj, i_s, i_t) := cells_to_doors_graph cells s t in
-  (adj, shortest_path node node_eqb (seq.nth [::] adj.2) i_s
-    i_t _ empty
-   gfind update pop (iota 0 (size adj.2)), i_s, i_t).
+  (adj, shortest_path R R0 R_ltb R_add node node_eqb
+         (seq.nth [::] adj.2) i_s i_t _ empty
+         gfind update pop (iota 0 (size adj.2)), i_s, i_t).
 
 Definition midpoint (p1 p2 : pt) : pt :=
  {| p_x := R_div (R_add (p_x p1) (p_x p2)) R2;
     p_y := R_div (R_add (p_y p1) (p_y p2)) R2|}.
 
+(* The center of the cell is computed using the middle of the high edge
+   the middle of the low edge, and their middle. *)
 Definition cell_center (c : cell) :=
   midpoint
     (midpoint (seq.last dummy_pt (left_pts c)) 
@@ -688,9 +687,16 @@ Definition cell_center (c : cell) :=
     (midpoint (head dummy_pt (left_pts c))
               (seq.last dummy_pt (right_pts c))).
 
+(* Each point used in the doors is annotated with the doors on which they
+  are and the cells they connect.  The last information may be useless
+  since we have now door information. *)
 Record annotated_point :=
   Apt { apt_val : pt; door_index : option nat; cell_indices : seq nat}.
 
+(* Given two points p1 and p2 on a side of a cell, this computes a point
+   inside the cell that is a sensible intermediate point to move from p1
+   to p2 while staying safely inside the cell. *)
+  
 Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
    (ci : nat) :=
   let new_x := p_x (cell_center c) in
@@ -701,6 +707,9 @@ Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
     else
       Apt (cell_center c) None (ci :: nil).
 
+(* When two neighbor doors are aligned vertically, they have a neighboring
+   cell in common.  This can be computed by looking at the intersection
+   between their lists of neighboring cells. *)
 Definition intersection (s1 s2 : seq nat) :=
   [seq x | x <- s1 & existsb (fun y => Nat.eqb x y) s2].
 
@@ -733,13 +742,6 @@ Fixpoint a_shortest_path (cells : seq cell)
        p :: a_shortest_path cells doors s t a_p' tlpath
   end.
 
-Fixpoint path_to_segments (p : annotated_point)
-   (path : seq annotated_point) : seq (annotated_point * annotated_point) :=
-  match path with
-  | nil => nil
-  | p' :: tl => (p, p') :: path_to_segments p' tl
-  end.
-
 Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
   List.map (fun p => (snd p, fst p)) (List.rev_append s nil).
 
@@ -759,7 +761,7 @@ Definition source_to_target
       match a_shortest_path cells doors source target
                 last_point path with
       | nil => None
-      | a :: tl => Some(doors.1, path_reverse (path_to_segments a tl))
+      | a :: tl => Some(doors.1, path_reverse (seq_to_intervals_aux a tl))
     end
   else
     None.
@@ -846,12 +848,12 @@ Fixpoint check_bezier_ccw (fuel : nat) (v : vert_edge)
 match fuel with
 | O => None
 | S p =>
-  let top_edge := Bpt (ve_x v)  (ve_top v) in
-  if negb (point_under_edge top_edge (Bedge a c)) then
+  let top_of_edge := Bpt (ve_x v)  (ve_top v) in
+  if negb (point_under_edge top_of_edge (Bedge a c)) then
     Some true
   else if
-     point_under_edge top_edge (Bedge a b) ||
-     point_under_edge top_edge (Bedge b c)
+     point_under_edge top_of_edge (Bedge a b) ||
+     point_under_edge top_of_edge (Bedge b c)
   then 
     Some false
   else
@@ -878,12 +880,12 @@ Fixpoint check_bezier_cw (fuel : nat) (v : vert_edge)
 match fuel with
 | O => None
 | S p =>
-  let bot_edge := Bpt (ve_x v)  (ve_bot v) in
-  if point_strictly_under_edge bot_edge (Bedge a c) then
+  let bot_of_edge := Bpt (ve_x v)  (ve_bot v) in
+  if point_strictly_under_edge bot_of_edge (Bedge a c) then
     Some true
   else if
-     negb (point_strictly_under_edge bot_edge (Bedge a b)) ||
-     negb (point_strictly_under_edge bot_edge (Bedge b c))
+     negb (point_strictly_under_edge bot_of_edge (Bedge a b)) ||
+     negb (point_strictly_under_edge bot_of_edge (Bedge b c))
   then 
     Some false
   else
@@ -977,6 +979,15 @@ Definition smooth_from_cells (cells : seq cell)
   | None => nil
   end.
 
+Definition point_to_point (bottom top : edge) (obstacles : seq edge)
+  (initial final : pt) : seq curve_element :=
+  let cells := edges_to_cells bottom top obstacles in
+  match source_to_target cells initial final with
+  | Some (doors, s) => 
+    List.map (fun '(a, b) => straight a b) s
+  | None => nil
+  end.
+
 (* This function wraps up all operations:
   - constructing the cells
   - constructing the broken line
diff --git a/theories/shortest_path.v b/theories/shortest_path.v
index 8145e38..3f3f537 100644
--- a/theories/shortest_path.v
+++ b/theories/shortest_path.v
@@ -1,35 +1,38 @@
 From mathcomp Require Import all_ssreflect all_algebra.
-Require Import ZArith (* List *) String OrderedType OrderedTypeEx FMapAVL.
-Require Import smooth_trajectories.
+Require Import ZArith String OrderedType OrderedTypeEx FMapAVL.
 
 Notation head := seq.head.
 Notation seq := seq.seq.
 Notation nth := seq.nth.
 Notation sort := path.sort.
 
+Import Order.POrderTheory Order.TotalTheory.
+
 Section shortest_path.
 
 Variable R : Type.
 Variable R0 : R.
-Variable ltb : R -> R -> bool.
-Variable add : R -> R -> R.
+Variable R_ltb : R -> R -> bool.
+Variable R_add : R -> R -> R.
+
 Variable cell : Type.
 Variable node : Type.
 Variable node_eqb : node -> node -> bool.
 Variable neighbors_of_node : node -> seq (node * R).
 Variable source target : node.
 
-Definition path := seq node.
 Variable priority_queue : Type.
 Variable empty : priority_queue.
-Variable find : priority_queue -> node -> option (path * option R).
-Variable update : priority_queue -> node -> path -> option R -> priority_queue.
-Variable pop :  priority_queue -> option (node * path * option R * priority_queue).
+Variable gfind : priority_queue -> node -> option (seq node * option R).
+Variable update : priority_queue -> node -> seq node -> option R ->
+      priority_queue.
+Variable pop :  priority_queue ->
+       option (node * seq node * option R * priority_queue).
 
 Definition cmp_option (v v' : option R) :=
   if v is Some x then
     if v' is Some y then
-       (ltb x y)%O
+       (R_ltb x y)%O
     else
       true
    else
@@ -38,11 +41,11 @@ Definition cmp_option (v v' : option R) :=
 Definition Dijkstra_step (d : node) (p : seq node) (dist : R)
   (q : priority_queue) : priority_queue :=
   let neighbors := neighbors_of_node d in
-  foldr (fun '(d', dist') q => 
-           match find q d' with
+  foldr (fun '(d', dist') q =>
+           match gfind q d' with
            | None => q
            | Some (p', o_dist) =>
-             let new_dist_to_d' := Some (add dist dist')%R in
+             let new_dist_to_d' := Some (R_add dist dist') in
              if cmp_option new_dist_to_d' o_dist then
                 update q d' (d :: p) new_dist_to_d'
              else q
@@ -54,7 +57,7 @@ Fixpoint Dijkstra (fuel : nat) (q : priority_queue) :=
   |S fuel' =>
     match pop q with
     | Some (d, p, Some dist, q') =>
-      if node_eqb d target then Some p else 
+      if node_eqb d target then Some p else
         Dijkstra fuel' (Dijkstra_step d p dist q')
     | _ => None
     end
@@ -67,171 +70,79 @@ Definition shortest_path (s : seq node) :=
 
 End shortest_path.
 
-Import generic_trajectories.
-Notation cell := (cell R edge).
-
-Notation v_eqb := (vert_edge_eqb R QArith_base.Qeq_bool).
-Notation cell_left_doors :=
-   (cell_safe_exits_left R (QArith_base.inject_Z 1) edge).
-Notation cell_right_doors :=
-   (cell_safe_exits_right R (QArith_base.inject_Z 1) edge).
-
-Notation dummy_cell := (dummy_cell R (QArith_base.inject_Z 1) edge Bedge).
-
-Definition index_seq {T : Type} (s : list T) : list (nat * T) :=
-  zip (iota 0 (size s)) s.
-
-Definition cells_to_doors (s : list cell) :=
-  let indexed_s := index_seq s in
-  let vert_edges_and_right_cell :=
-    flatten (map (fun '(i, c) => 
-                   (map (fun v => (v, i))) (cell_left_doors c))
-      indexed_s) in
-  let vert_edges_and_both_cells :=
-    flatten (map (fun '(v, i) => 
-          (map (fun '(i', c') => (v, i, i'))
-               (filter (fun '(i', c') =>
-                   existsb (v_eqb v) (cell_right_doors c'))
-                   indexed_s)))
-           vert_edges_and_right_cell) in 
-      vert_edges_and_both_cells.
-
-Notation on_vert_edge :=
-  (on_vert_edge R QArith_base.Qeq_bool QArith_base.Qle_bool).
-
-Notation vert_edge_midpoint :=
-  (vert_edge_midpoint R QArith_base.Qplus QArith_base.Qdiv  (QArith_base.inject_Z 1)).
-
-Definition vert_edge_to_reference_point (s t : pt R) (v : vert_edge R) :=
-  if on_vert_edge s v then s
-  else if on_vert_edge t v then t
-  else vert_edge_midpoint v.
-
-Definition one_door_neighbors
-  (indexed_doors : seq (nat * (vert_edge R * nat * nat)))
-  (i_d : nat * (vert_edge R * nat * nat)) : list nat :=
-  match i_d with
-  | (j, (v0, i0, i'0)) =>
-    map fst
-      (filter (fun '(vi, (v, i, i')) => (Nat.eqb i i0  || Nat.eqb i i'0 ||
-              Nat.eqb i' i0 || Nat.eqb i' i'0) && (negb (Nat.eqb j vi)))
-          indexed_doors)
-  end.
-
-Notation strict_inside_closed :=
-  (strict_inside_closed R QArith_base.Qeq_bool QArith_base.Qle_bool QArith_base.Qplus QArith_base.Qminus QArith_base.Qmult (QArith_base.inject_Z 1) edge left_pt
-   right_pt).
-
-Definition add_extremity_reference_point
-  (indexed_cells : seq (nat * cell))
-  (doors : seq (vert_edge R * nat * nat)) (p : pt R) :=
-  if existsb (fun '(v, _, _) => on_vert_edge p v) doors then
-    [::]
-  else 
-    let '(i, c) :=
-      head (size indexed_cells, dummy_cell)
-        (filter (fun '(i', c') => strict_inside_closed p c')  indexed_cells) in
-      [:: ({|ve_x := p_x _ p; ve_top := p_y _ p; ve_bot := p_y _ p|}, i, i)].
-
-Definition doors_and_extremities (indexed_cells : seq (nat * cell))
-  (doors : seq (vert_edge R * nat * nat)) (s t : pt R) :=
-  add_extremity_reference_point indexed_cells doors s ++
-  add_extremity_reference_point indexed_cells doors t ++
-  doors.
-
-Definition door_adjacency_map (doors : seq (vert_edge R * nat * nat)) :
-  seq (seq nat) :=
-  let indexed_doors := index_seq doors in
-  map (fun i_d => one_door_neighbors indexed_doors i_d) indexed_doors.
-
-Notation dummy_vert_edge :=
- (dummy_vert_edge R QArith_base.Qminus (QArith_base.inject_Z 1)).
-
-Definition dummy_door := (dummy_vert_edge, 0, 0).
-
-Definition distance (doors : seq (vert_edge R * nat * nat)) (s t : pt R) 
-  (i j : nat) :=
-  let '(v1, _, _) := nth dummy_door doors i in
-  let '(v2, _, _) := nth dummy_door doors j in
-  let p1 := vert_edge_to_reference_point s t v1 in
-  let p2 := vert_edge_to_reference_point s t v2 in
-  pt_distance p1 p2.
-
-Definition cells_to_doors_graph (cells : seq cell) (s t : pt R) :=
-  let regular_doors := cells_to_doors cells in
-  let indexed_cells := index_seq cells in
-  let full_seq_of_doors :=
-    doors_and_extremities indexed_cells regular_doors s t in
-  let adj_map := door_adjacency_map full_seq_of_doors in
-  let neighbors_and_distances :=
-    [seq [seq (j, distance full_seq_of_doors s t i j) | j <- neighbors]
-        | '(i, neighbors) <- index_seq adj_map] in
-      (full_seq_of_doors, neighbors_and_distances).
-
-(* TODO : beware of the case where s and t are on the same door, they can't
-   both be the reference point! *)
-
-Import generic_trajectories.
-
-Definition node := nat.
-
-Definition empty := @nil (node * path node * option R).
-
-Notation priority_queue := (list (node * path node * option R)).
-
-Definition node_eqb := Nat.eqb.
-
-Fixpoint find (q : priority_queue) n :=
-  match q with
-  | nil => None
-  | (n', p, d) :: tl => if node_eqb n' n then Some (p, d) else find tl n
-  end.
-
-Fixpoint remove (q : priority_queue) n :=
-  match q with
-  | nil => nil
-  | (n', p', d') :: tl =>
-    if node_eqb n' n then
-      tl
-    else
-      (n', p', d') :: remove tl n
-  end.
-
-Fixpoint insert (q : priority_queue) n p d :=
-  match q with
-  | nil => (n, p, d) :: nil
-  | (n', p', d') :: tl =>
-    if cmp_option R QArith_base.Qle_bool d d' then
-      (n, p, d) :: q
-    else
-      (n', p', d') :: insert tl n p d
-  end.
-
-Definition update q n p d :=
-  insert (remove q n) n p d.
-
-Definition pop  (q : priority_queue) :
-   option (node * path node * option R * priority_queue) :=
-  match q with
-  | nil => None
-  | v :: tl => Some (v, tl)
-  end.
-
-Section example.
-
-Import QArith.
-Check Qedges_to_cells.
-Definition bottom := Bedge (Bpt _ 0 0) (Bpt _ 4 0).
-Definition top := Bedge (Bpt _ 0 4) (Bpt _ 4 4).
-Definition edges := [:: Bedge (Bpt _ 1 2) (Bpt _ 3 2)].
-Definition start := Bpt _ 1.2 3.
-Definition target := Bpt _ 1.2 1.
-Notation Bpt := (smooth_trajectories.Bpt _).
-
-Definition adj := cells_to_doors_graph (Qedges_to_cells bottom top edges)
-                      start target.
-Compute adj.                      
-Compute shortest_path R 0 Qlt_bool Qplus nat Nat.eqb
-    (nth nil adj.2) 0%N 1%N _ empty find update pop (iota 0 (size adj.2)).
-
-End example.
+Section shortest_path_proofs.
+
+Variable R : realDomainType.
+
+Variable node : eqType.
+
+Variable neighbors : node -> seq (node * R).
+
+Variable queue : Type.
+Variable empty : queue.
+Variable find : queue -> node -> option (seq node * option R).
+Variable update : queue -> node -> seq node -> option R -> queue.
+Variable pop :  queue -> option (node * seq node * option R * queue).
+
+Hypothesis find_empty : 
+  forall n, find empty n = None.
+Hypothesis find_update_eq : forall q n p d p' d',
+  find q n = Some(p', d') -> cmp_option R <%R d d' ->
+  find (update q n p d) n = Some(p, d).
+Hypothesis find_update_None : forall q n p d,
+  find q n = None -> find (update q n p d) n = Some(p, d).
+Hypothesis find_update_diff : forall q n1 n2 p d,
+  n1 != n2 ->
+  find (update q n1 p d) n2 = find q n2.
+Hypothesis pop_remove :
+  forall q n p d q', pop q = Some (n, p, d, q') -> 
+  find q' n = None.
+Hypothesis pop_find :
+  forall q n p d q', pop q = Some (n, p, d, q') -> 
+  find q n = Some(p, d).
+Hypothesis pop_diff :
+  forall q n1 n2 p d q', pop q = Some(n1, p, d, q') ->
+    n1 != n2 ->
+    find q' n2 = find q n2.
+Hypothesis pop_min : forall q n1 n2 p p' d d' q',
+    pop q = Some(n1, p, d, q') ->
+    find q n2 = Some(p', d') -> cmp_option _ <%R d d'.
+Hypothesis update_discard :
+  forall q n p d p' d',
+    find q n = Some(p, d) ->
+    ~~ cmp_option _ <%R d' d ->
+    find (update q n p' d') n = find q n.
+
+Lemma oltNgt (d1 d2 : option R) : cmp_option _ <%R d1 d2 ->
+                      ~~ cmp_option _ <%R d2 d1.
+Proof.
+case: d1 => [d1 | ]; case: d2 => [d2 | ] //.
+rewrite /cmp_option.
+by rewrite -leNgt le_eqVlt orbC => ->.
+Qed.
+
+Lemma update_update q n1 n2 n3 p d p' d' :
+    find (update (update q n1 p d) n2 p' d') n3 =
+    find (update (update q n2 p' d') n1 p d) n3.
+Proof.
+have [n1n3 | n1nn3] := eqVneq n1 n3.
+  rewrite -n1n3.
+  have [n1n2 | n1nn2] := eqVneq n1 n2.
+    rewrite -n1n2.
+    case n1inq : (find q n1) => [ [p1  d1] | ].
+      case cmp1 : (cmp_option _ <%R d d1).
+        case cmp2 :(cmp_option _ <%R d' d).
+          have int1 : find (update q n1 p d) n1 = Some(p, d).
+            by apply: find_update_eq n1inq cmp1.
+          rewrite (find_update_eq _ _ _ _ _ _ int1 cmp2).
+          have [cmp3 | cmp3]:= boolP(cmp_option _ <%R d' d1).
+            have int2 : find (update q n1 p' d') n1 = Some(p', d').
+              by apply: find_update_eq n1inq cmp3.
+            rewrite (update_discard _ _ _ _ _ _ int2); last by apply: oltNgt.
+          by rewrite int2.
+        have int3 : find (update q n1 p' d') n1 = Some (p1, d1).
+          by rewrite (update_discard _ _ _ _ _ _ n1inq).
+        have : ~~ cmp_option _ <%R d d1.
+Admitted.
+
+End shortest_path_proofs.
diff --git a/theories/smooth_trajectories.v b/theories/smooth_trajectories.v
index 155ef37..2aa1993 100644
--- a/theories/smooth_trajectories.v
+++ b/theories/smooth_trajectories.v
@@ -45,6 +45,10 @@ Definition euclidean_distance  (p1x p1y p2x p2y : R) :=
 
 Definition pt_distance := euclidean_distance.
 
+Definition Qpoint_to_point :=
+  point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
+   pt_distance 1 edge Bedge left_pt right_pt.
+
 Definition Qsmooth_point_to_point :=
  smooth_point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
    pt_distance 1 edge Bedge left_pt right_pt.
diff --git a/www/Makefile.coq.local b/www/Makefile.coq.local
index 7b0ca27..86b4c69 100644
--- a/www/Makefile.coq.local
+++ b/www/Makefile.coq.local
@@ -9,7 +9,7 @@ clean::
 
 
 SmoothTrajectories.ml SmoothTrajectories.mli : ../theories/smooth_trajectories.vo
-	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
+	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qpoint_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
 	cp ../theories/SmoothTrajectories.ml ../theories/SmoothTrajectories.mli .
 
 SmoothTrajectories.cmi : SmoothTrajectories.mli

From acac84a4d65af7632f6011d9497d9f5fd26c86aa Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 30 Apr 2024 16:37:39 +0200
Subject: [PATCH 27/43] rename Qpoint_to_point into Qstraight_point_to_point

---
 theories/smooth_trajectories.v | 2 +-
 www/Makefile.coq.local         | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/theories/smooth_trajectories.v b/theories/smooth_trajectories.v
index 2aa1993..8eb2669 100644
--- a/theories/smooth_trajectories.v
+++ b/theories/smooth_trajectories.v
@@ -45,7 +45,7 @@ Definition euclidean_distance  (p1x p1y p2x p2y : R) :=
 
 Definition pt_distance := euclidean_distance.
 
-Definition Qpoint_to_point :=
+Definition Qstraight_point_to_point :=
   point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
    pt_distance 1 edge Bedge left_pt right_pt.
 
diff --git a/www/Makefile.coq.local b/www/Makefile.coq.local
index 86b4c69..3465d69 100644
--- a/www/Makefile.coq.local
+++ b/www/Makefile.coq.local
@@ -9,7 +9,7 @@ clean::
 
 
 SmoothTrajectories.ml SmoothTrajectories.mli : ../theories/smooth_trajectories.vo
-	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qpoint_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
+	cd ../theories; echo 'Require Import QArith smooth_trajectories. Extraction "SmoothTrajectories.ml" Qsmooth_point_to_point Qstraight_point_to_point Qedges_to_cells Qreduction.Qred.' | coqtop -R . trajectories
 	cp ../theories/SmoothTrajectories.ml ../theories/SmoothTrajectories.mli .
 
 SmoothTrajectories.cmi : SmoothTrajectories.mli

From d73e8abf2dd26c869a1f39a5795cfd9b9b95cf16 Mon Sep 17 00:00:00 2001
From: thery <Laurent.Thery@inria.fr>
Date: Wed, 1 May 2024 07:18:45 +0200
Subject: [PATCH 28/43] Adding straight line

---
 www/grid.html              |   2 +
 www/grid.js                | 121 ++++++++++++++++++++++++++++++++++++-
 www/jSmoothTrajectories.ml |  15 +++--
 3 files changed, 130 insertions(+), 8 deletions(-)

diff --git a/www/grid.html b/www/grid.html
index 8452fd9..d2d69b3 100755
--- a/www/grid.html
+++ b/www/grid.html
@@ -28,6 +28,8 @@
 <label for="Position">Starting and ending positions</label> 
 <input type="checkbox" id="cell" name="Show Cells">
 <label> Show Cells </label>
+<input type="checkbox" id="straight" name="Show Straight">
+<label> Show Straight </label>
 <p>
 <button id="loadButton">Load</button>
 <button id="saveButton">Save</button>
diff --git a/www/grid.js b/www/grid.js
index 0b353fe..291fa68 100644
--- a/www/grid.js
+++ b/www/grid.js
@@ -256,6 +256,10 @@ function cleanCurve () {
 }
 
 function getCurve() {
+  console.log("getCurve\n");
+  if (positions == null) {
+    return;
+  }
   let val = "";
   val += outVal(positions.fX) + outVal(positions.fZ) + 
          outVal(positions.tX) + outVal(positions.tZ);
@@ -332,6 +336,105 @@ function getCurve() {
   }
 }
 
+/* The straight */
+
+var straightFlag = true;
+
+const straightButtons = 
+  document.querySelectorAll('input[name="Show Straight"]');
+
+for (const straightButton of straightButtons) {
+    straightButton.addEventListener("click", setStraight, false);
+}
+
+function setStraight() {
+    straightFlag = straightButtons[0].checked;
+    cleanStraight();
+    cleanCurve();
+    if (straightFlag) {
+      getStraight();
+    } else {
+      getCurve();
+    }
+    renderer.render( scene, camera );
+}
+
+
+var straights = [];
+const smaterial = new THREE.LineBasicMaterial( { color: 'orange' } );
+setStraight();
+
+
+function cleanStraight () {
+    let i = 0; 
+    console.log("straights " + straights);
+    while (i < straights.length)
+    for (const straight of straights) {
+        scene.remove(straight);
+        i++;
+    }
+    renderer.render( scene, camera ); 
+    straights = [];
+}
+
+function getStraight() {
+  console.log("getStraight\n");
+  if (positions == null) {
+    return;
+  }
+  let val = "";
+  val += outVal(positions.fX) + outVal(positions.fZ) + 
+         outVal(positions.tX) + outVal(positions.tZ);
+  if (borders.length != 2) {
+    return;
+  }
+  if (borders[0].fZ <= borders[1].fZ) {
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+  } else {
+    val += outVal(borders[1].fX) + outVal(borders[1].fZ) + 
+           outVal(borders[1].tX) + outVal(borders[1].tZ);  
+    val += outVal(borders[0].fX) + outVal(borders[0].fZ) + 
+           outVal(borders[0].tX) + outVal(borders[0].tZ);  
+  }
+  for (const obstacle of obstacles) {
+    val += outVal(obstacle.fX) + outVal(obstacle.fZ)
+            + outVal(obstacle.tX) + outVal(obstacle.tZ);  
+  } 
+  console.log("boarders " + borders.length + " obstacles " + obstacles.length);
+  console.log("val " + val);
+  let res = ocamlLib.straight(val);
+  console.log("res " + res);
+  let res1 = res.split(' ').map(Number);
+  let i = 0;
+  while (i < res1.length) {
+    if (res1[i] == 1) {
+        /* Straight line */
+        let fx = res1[i + 2] / res1 [i + 3] * gSize - 0.5 - gSize/2;
+        let fy = 0.3;
+        let fz = res1[i + 4] / res1 [i + 5] * gSize - 0.5 - gSize/2;
+        let tx = res1[i + 6] / res1 [i + 7] * gSize - 0.5 - gSize/2;
+        let ty = 0.3;
+        let tz = res1[i + 8] / res1 [i + 9] * gSize - 0.5 - gSize/2;
+        console.log("Adding a line" + fx + " " + fz + " " + tx + " " + tz);
+        let epoints = [];
+        epoints.push( new THREE.Vector3(fx, fy, fz) );
+        epoints.push( new THREE.Vector3(tx, ty, tz));
+        let egeometry = new THREE.BufferGeometry().setFromPoints( epoints );
+        let sline = new THREE.Line( egeometry, smaterial );
+        straights.push(sline);
+        scene.add( sline );
+        renderer.render( scene, camera );
+        i += 10;
+    } else if (res1[i] == 2) {
+        i += 14;
+    } else {
+        i++;
+    }
+  }
+}
 
 /* The modality */
 
@@ -346,6 +449,7 @@ for (const radioButton of radioButtons) {
 
 function setModality() {
     cleanCurve();
+    cleanStraight();
     fromValid = false;  
     toValid = false;         
     fromCube.position.y = -0.2;
@@ -400,6 +504,7 @@ function onDocumentMouseDown( event ) {
         fromCube.position.y = -0.2;
         toCube.position.y = -0.2;
         cleanCurve();
+        cleanStraight();
         renderer.render( scene, camera );  
     }
     if (fromValid) {
@@ -419,6 +524,7 @@ function onDocumentMouseDown( event ) {
                 return;
             }
             cleanCurve();
+            cleanStraight();
             addObstacle(fromX, fromZ, toX, toZ);
         }
         if (modality == "positions") {
@@ -430,7 +536,12 @@ function onDocumentMouseDown( event ) {
             renderer.render( scene, camera );
             positions = {fX : fromX, fZ : fromZ, tX : toX, tZ : toZ }
             cleanCurve();
-            getCurve();
+            cleanStraight();
+            if (straightFlag) {
+                getStraight();
+            } else {
+                getCurve();
+            }
         }
     } else {
         fromValid = true;         
@@ -441,6 +552,7 @@ function onDocumentMouseDown( event ) {
         fromCube.position.x = fromX;
         toCube.position.y = -0.2;
         cleanCurve();
+        cleanStraight();
         renderer.render( scene, camera );
     }
 }
@@ -504,7 +616,12 @@ document.getElementById('loadButton').addEventListener('click', function() {
                     renderer.render( scene, camera );
                     positions = {fX : fX, fZ : fZ, tX : tX, tZ : tZ }
                     cleanCurve();
-                    getCurve();
+                    cleanStraight();
+                    if (straightFlag) {
+                        getStraight();
+                    } else {
+                        getCurve();
+                    }
                     renderer.render( scene, camera );
                 }
             };
diff --git a/www/jSmoothTrajectories.ml b/www/jSmoothTrajectories.ml
index 67f8520..f06aeb1 100644
--- a/www/jSmoothTrajectories.ml
+++ b/www/jSmoothTrajectories.ml
@@ -91,7 +91,7 @@ let call_smooth s =
     l2stringr (curve_elements2n v)
 
 
-let call_smooth1 s = 
+let call_straight s = 
   let l = string2ln s in
   match l with
   | p1n1 :: p1d1 :: p1n2 :: p1d2 :: p2n1 :: p2d1 :: p2n2 ::p2d2 ::
@@ -99,11 +99,13 @@ let call_smooth1 s =
     e2n1 :: e2d1 :: e2n2 :: e2d2 :: e2n3 :: e2d3 :: e2n4 :: e2d4 ::
     ls ->
     let es = list2es ls in 
- ((n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4),
-  (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4),
-      es ,
-      (n2pt p1n1 p1d1 p1n2 p1d2),
-      (n2pt p2n1 p2d1 p2n2 p2d2)) 
+    let v = qstraight_point_to_point (n2edge e1n1 e1d1 e1n2 e1d2 e1n3 e1d3 e1n4 e1d4)
+      (n2edge e2n1 e2d1 e2n2 e2d2 e2n3 e2d3 e2n4 e2d4)
+      es 
+      (n2pt p1n1 p1d1 p1n2 p1d2)
+      (n2pt p2n1 p2d1 p2n2 p2d2) in 
+    l2stringr (curve_elements2n v)
+
 
 let rec cells_element2n ce =
   match ce with
@@ -132,6 +134,7 @@ let call_cells s =
 let _ =
   Js.export "ocamlLib"
     (object%js
+      method straight s = Js.string (call_smooth (Js.to_string s))
       method smooth s = Js.string (call_smooth (Js.to_string s))
       method cells s = Js.string (call_cells (Js.to_string s))
     end)

From 0c98981bd4845e4ae7c0eb58e77a53e1384393fa Mon Sep 17 00:00:00 2001
From: thery <Laurent.Thery@inria.fr>
Date: Wed, 1 May 2024 07:34:21 +0200
Subject: [PATCH 29/43] fix refresh position

---
 www/grid.js | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/www/grid.js b/www/grid.js
index 291fa68..f310688 100644
--- a/www/grid.js
+++ b/www/grid.js
@@ -257,7 +257,7 @@ function cleanCurve () {
 
 function getCurve() {
   console.log("getCurve\n");
-  if (positions == null) {
+  if ((fromValid == false) || (toValid == false)) {
     return;
   }
   let val = "";
@@ -379,7 +379,7 @@ function cleanStraight () {
 
 function getStraight() {
   console.log("getStraight\n");
-  if (positions == null) {
+  if ((fromValid == false) || (toValid == false)) {
     return;
   }
   let val = "";

From ade48048a5d075d46e132d2a3e5ab99fbe669604 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Wed, 1 May 2024 08:00:11 +0200
Subject: [PATCH 30/43] use call_straight at the right place

---
 www/jSmoothTrajectories.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/www/jSmoothTrajectories.ml b/www/jSmoothTrajectories.ml
index f06aeb1..cd552f3 100644
--- a/www/jSmoothTrajectories.ml
+++ b/www/jSmoothTrajectories.ml
@@ -134,7 +134,7 @@ let call_cells s =
 let _ =
   Js.export "ocamlLib"
     (object%js
-      method straight s = Js.string (call_smooth (Js.to_string s))
+      method straight s = Js.string (call_straight (Js.to_string s))
       method smooth s = Js.string (call_smooth (Js.to_string s))
       method cells s = Js.string (call_cells (Js.to_string s))
     end)

From 34a33604f347de7e3c32bb8649b8d7d693f0abec Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Fri, 3 May 2024 09:53:59 +0200
Subject: [PATCH 31/43] straight line trajectories in blue

---
 www/grid.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/www/grid.js b/www/grid.js
index f310688..0762b6d 100644
--- a/www/grid.js
+++ b/www/grid.js
@@ -361,7 +361,7 @@ function setStraight() {
 
 
 var straights = [];
-const smaterial = new THREE.LineBasicMaterial( { color: 'orange' } );
+const smaterial = new THREE.LineBasicMaterial( { color: 'blue' } );
 setStraight();
 
 

From 5f34171453beb85fd90cff4adf4c1bb809bf87fb Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Fri, 3 May 2024 21:06:30 +0200
Subject: [PATCH 32/43] add some form of improvement for straight trajectories

---
 theories/generic_trajectories.v | 107 ++++++++++++++++++++++++++++----
 theories/smooth_trajectories.v  |   3 +
 2 files changed, 99 insertions(+), 11 deletions(-)

diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index ab59cc9..f59366e 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -32,8 +32,6 @@ Notation sort := path.sort.
 
 Notation seq := list.
 
-Module natmap := FMapAVL.Make Nat_as_OT.
-
 Section generic_implementation.
 
 (* In the original development R has type numFieldType and the various
@@ -53,6 +51,8 @@ Notation "x - y" := (R_sub x y).
 
 Notation "x + y" := (R_add x y).
 
+Notation "x / y" := (R_div x y).
+
 Variable pt_distance : R -> R -> R -> R -> R.
 
 Variable R1 : R.
@@ -693,19 +693,32 @@ Definition cell_center (c : cell) :=
 Record annotated_point :=
   Apt { apt_val : pt; door_index : option nat; cell_indices : seq nat}.
 
+(* This value (1/16) of margin is suitable for the demo environment.  In real
+  life,  this should be a parameter of the algorithm. *)
+Definition margin := R1 / ((R1 + R1) *
+                             (R1 + R1) * (R1 + R1) * (R1 + R1) * (R1 * R1)).
+
+
 (* Given two points p1 and p2 on a side of a cell, this computes a point
    inside the cell that is a sensible intermediate point to move from p1
    to p2 while staying safely inside the cell. *)
-  
 Definition safe_intermediate_point_in_cell (p1 p2 : pt) (c : cell)
    (ci : nat) :=
   let new_x := p_x (cell_center c) in
   let new_y := R_div (R_add (p_y p1) (p_y p2)) R2 in
-  let new_pt := {|p_x := new_x; p_y := new_y|} in
-    if strict_inside_closed new_pt c then
-      Apt new_pt None (ci :: nil)
-    else
-      Apt (cell_center c) None (ci :: nil).
+  if R_ltb new_x (p_x p1) then
+    let new_pt := {|p_x := p_x p1 - margin; p_y := new_y|} in
+      if strict_inside_closed new_pt c then
+        Apt new_pt None (ci :: nil)
+      else
+        Apt (cell_center c) None (ci :: nil)
+  else
+    let new_pt := {|p_x := p_x p1 + margin; p_y := new_y|} in
+      if strict_inside_closed new_pt c then
+        Apt new_pt None (ci :: nil)
+      else
+        Apt (cell_center c) None (ci :: nil).
+
 
 (* When two neighbor doors are aligned vertically, they have a neighboring
    cell in common.  This can be computed by looking at the intersection
@@ -745,6 +758,72 @@ Fixpoint a_shortest_path (cells : seq cell)
 Definition path_reverse (s : seq (annotated_point * annotated_point)) :=
   List.map (fun p => (snd p, fst p)) (List.rev_append s nil).
 
+Definition intersect_vert_edge (p1 p2 : pt) (ve : vert_edge) : pt :=
+  Bpt (ve_x ve)
+    (p_y p1 + (ve_x ve - p_x p1) / (p_x p2 - p_x p1) * (p_y p2 - p_y p1)).
+
+Definition optim_three (doors : seq door) (p1 p2 p3 : annotated_point) :=
+  let p1' := apt_val p1 in
+  let p3' := apt_val p3 in
+  if p2 is Apt p2' (Some d_i) cells then
+    let d := (seq.nth dummy_door doors d_i).1.1 in
+    if R_ltb (p_x p1') (ve_x d) && R_ltb (ve_x d) (p_x p3') then
+      if R_ltb R0 (area3 p1' p2' p3') then
+        if R_ltb R0 (area3 p1' p3' (Bpt (ve_x d) (ve_top d))) then
+          let p2_2 := intersect_vert_edge p1' p3' d in
+            Apt p2_2 (Some d_i) cells
+        else
+          if R_ltb (ve_bot d) (ve_top d - margin) then
+            Apt (Bpt (ve_x d) (ve_top d - margin)) (Some d_i) cells
+          else
+            p2
+      else
+        if R_ltb (area3 p1' p3' (Bpt (ve_x d) (ve_bot d))) R0 then
+          let p2_2 := intersect_vert_edge p1' p3' d in
+            Apt p2_2 (Some d_i) cells
+        else
+          if R_ltb (ve_bot d + margin) (ve_top d) then
+            Apt (Bpt (ve_x d) (ve_bot d + margin)) (Some d_i) cells
+          else
+            p2
+    else if R_ltb (p_x p3') (ve_x d) && R_ltb (ve_x d) (p_x p1') then
+      if R_ltb R0 (area3 p1' p2' p3') then
+        if R_ltb R0 (area3 p1' p3' (Bpt (ve_x d) (ve_bot d))) then
+          let p2_2 := intersect_vert_edge p1' p3' d in
+            Apt p2_2 (Some d_i) cells
+        else
+          if R_ltb (ve_bot d + margin) (ve_top d) then
+            Apt (Bpt (ve_x d) (ve_bot d + margin)) (Some d_i) cells
+          else
+            p2
+      else
+        if R_ltb (area3 p1' p3' (Bpt (ve_x d) (ve_top d))) R0 then
+          let p2_2 := intersect_vert_edge p1' p3' d in
+            Apt p2_2 (Some d_i) cells
+        else
+          if R_ltb (ve_bot d) (ve_top d - margin) then
+            Apt (Bpt (ve_x d) (ve_top d - margin)) (Some d_i) cells
+          else
+            p2
+    else
+      p2
+  else
+    p2.
+
+Fixpoint local_improvements (doors : seq door)
+  (p : seq (annotated_point * annotated_point)) :
+  seq (annotated_point * annotated_point) :=
+match p with
+| (p1, p2) :: ((_ , p3) :: _) as tl =>
+  match local_improvements doors tl with
+  | [::] => p
+  | (_, p3') :: tl' =>
+    let p2' := optim_three doors p1 p2 p3' in
+      (p1, p2') :: (p2', p3') :: tl'
+  end
+| _ => p
+end.
+
 Definition source_to_target
  (cells : seq cell) (source target : pt) :
   option (seq door *
@@ -761,7 +840,10 @@ Definition source_to_target
       match a_shortest_path cells doors source target
                 last_point path with
       | nil => None
-      | a :: tl => Some(doors.1, path_reverse (seq_to_intervals_aux a tl))
+      | a :: tl =>
+         Some(doors.1,
+              local_improvements doors.1
+                (path_reverse (seq_to_intervals_aux a tl)))
     end
   else
     None.
@@ -973,12 +1055,15 @@ end.
 Definition smooth_from_cells (cells : seq cell)
   (initial final : pt) : seq curve_element :=
   match source_to_target cells initial final with
-  | Some (doors, s) => List.concat
-       (List.map (check_curve_element_and_repair fuel_constant doors)
+  | Some (doors, s) =>
+      List.concat
+         (List.map (check_curve_element_and_repair fuel_constant doors)
                               (smoothen (break_segments s)))
   | None => nil
   end.
 
+(* This function only computes the piecewise straight line trajectory,
+  starting from the sequence of edges and the source and target.       *)
 Definition point_to_point (bottom top : edge) (obstacles : seq edge)
   (initial final : pt) : seq curve_element :=
   let cells := edges_to_cells bottom top obstacles in
diff --git a/theories/smooth_trajectories.v b/theories/smooth_trajectories.v
index 8eb2669..50df61f 100644
--- a/theories/smooth_trajectories.v
+++ b/theories/smooth_trajectories.v
@@ -49,6 +49,9 @@ Definition Qstraight_point_to_point :=
   point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
    pt_distance 1 edge Bedge left_pt right_pt.
 
+Definition Qoptim_three := optim_three Q Qeq_bool Qle_bool Qplus Qminus
+  Qmult Qdiv 1.
+
 Definition Qsmooth_point_to_point :=
  smooth_point_to_point Q Qeq_bool Qle_bool Qplus Qminus Qmult Qdiv
    pt_distance 1 edge Bedge left_pt right_pt.

From 02deb906614859bf7087940b0013a9a7019afd88 Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Mon, 20 May 2024 10:59:54 +0200
Subject: [PATCH 33/43] adds slides for the Festschrift

---
 documents/FHG_slides.tex | 192 +++++++++++++++++++++++++++++++++++++++
 documents/Makefile       |   5 +-
 documents/collision.ps   | Bin 292 -> 378 bytes
 documents/collision2.ps  | Bin 324 -> 589 bytes
 4 files changed, 196 insertions(+), 1 deletion(-)
 create mode 100644 documents/FHG_slides.tex

diff --git a/documents/FHG_slides.tex b/documents/FHG_slides.tex
new file mode 100644
index 0000000..c345de6
--- /dev/null
+++ b/documents/FHG_slides.tex
@@ -0,0 +1,192 @@
+\documentclass[compress]{beamer}
+\usepackage[latin1]{inputenc}
+\usepackage{alltt}
+\newdimen\topcrop
+\topcrop=10cm  %alternatively 8cm if the pdf inclusions are in letter format
+\newdimen\topcropBezier
+\topcropBezier=19cm %alternatively 16cm if the inclusions are in letter format
+
+\setbeamertemplate{footline}[frame number]
+\title{Smooth trajectories in straight line mazes}
+\author{Yves Bertot\\
+Joint work with Thomas Portet, Quentin Vermande}
+\date{April 2023}
+\mode<presentation>
+\begin{document}
+
+\maketitle
+\begin{frame}
+\frametitle{The game}
+\begin{itemize}
+\item Apply Type Theory-based verification to a problem understood by a
+  wide audience
+\item Find a smooth path in a maze
+\item Decompose the problem
+\begin{itemize}
+\item Find a discrete approximation of the problem
+\item Construct a piece-wise linear path
+\item smoothen the angles
+\end{itemize}
+\item Prove the correctness of the algorithm
+\begin{itemize}
+\item Safety: absence of collision
+\item work in progress
+\end{itemize}
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Example}
+\includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{empty_spiral.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Cell decomposition}
+\begin{itemize}
+\item Decompose the space into simple cells
+\item Each cell is convex
+\item Each cell is free of obstacles
+\item Each cell may have neighbours where moving is safe
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Vertical cell decomposition example}
+\includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{cells_spiral.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Cell assumptions}
+\begin{itemize}
+\item Vertical edges are safe passages between two cells
+\item Moving directly from a left-edge to a right-edge is safe
+\begin{itemize}
+\item and vice-versa
+\end{itemize}
+\item Moving from a left-edge to the cell center is safe
+\begin{itemize}
+\item similarly for a right-edge
+\item moving from left-edge to left-edge is safe by going through the
+  cell center
+\end{itemize}
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Finding a path in the cell graph}
+\begin{itemize}
+\item A discrete path from cell to cell is found by breadth-first search
+\item Connected components of the graph are defined by polygons
+\item Special care for points that are already on the common edge of two cells
+\item Recent improvement: take distances into account
+\begin{itemize}
+\item Use a graph of doors instead of cells
+\item Easier to associate a distance between pairs of doors
+\item Dijkstra shortest path algorithm
+\end{itemize}
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Two examples of elementary safe paths}
+\includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{spiral_safe2.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{piecewise linear path}
+\label{broken-line}
+\includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{spiral_bline.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Making corners smooth}
+\begin{itemize}
+\item Using quadratic Bezier curves
+\item Bezier curves are given by a set of control points
+   (3 for a quadratic curve)
+\item Points on the curves are obtained by computing weighted barycenters
+\begin{itemize}
+\item The curve is enclosed in the convex hull of the control points
+\end{itemize}
+\item Given control points \(a_0, a_1, \ldots, a_{n-1}, a_n\), \(a_0, a_1\)
+is tangent to the curve in \(a_0\)
+\begin{itemize}
+\item same for \(a_{n-1}, a_n\) in \(a_n\)
+\end{itemize}
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Bezier curve illustration}
+\begin{itemize}
+\item How the point for ratio \(4/9\) is computed
+\item Control points for the two subcurves are given by the new point,
+the initial starting and end points, and the solid green straight edge tip
+\end{itemize}
+\includegraphics[trim={0 6cm 0 \topcropBezier}, clip, width=\textwidth]{bezier_example2.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Using Bezier curves for smoothing}
+\begin{itemize}
+\item Add extra points in the middle of each straight line segment
+\item Uses these extra points as first and last control points for Bezier curves
+\item Use the angle point as the middle control point
+\item Check the Bezier curve for collision and repair if need be
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Collision checking, graphically}
+\includegraphics[trim={0 4cm 0 17cm}, clip, width=\textwidth]{collision.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Not passing in the top door}
+\includegraphics[trim={0 4cm 0 17cm}, clip, width=\textwidth]{collision2.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Final trajectories}
+\label{final-spiral}
+\includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{smooth_spiral2.pdf}
+\end{frame}
+\begin{frame}
+\frametitle{Proof tools}
+\begin{itemize}
+\item Convex hulls (Pichardie \& B. 2001)
+\begin{itemize}
+\item Orientation predicate
+\item point below or above edge
+\end{itemize}
+\item Linear arithmetic
+\begin{itemize}
+\item Algorithms only use rational numbers
+\item Bezier curve intersections rely on algebraic numbers
+\end{itemize}
+\item Convex spaces and Bezier Curve
+\begin{itemize}
+\item Internship by Q. Vermande
+\item Using {\tt infotheo}, especially convex and conical spaces
+         (Affeldt \& Garrigue \& Saikawa 2020)
+\end{itemize}
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Vertical cell decomposition proofs}
+\begin{itemize}
+\item Use of semi-closed vertical cells
+\item Show disjoint property
+\item Show that obstacles are covered by cell tops
+\item This proof is complete
+\end{itemize}
+\end{frame}
+\begin{frame}
+\frametitle{Future work}
+\begin{itemize}
+\item Intend to prove only safety
+\item Produce concrete code from abstract models
+\begin{itemize}
+\item Move from exact computation to approximations
+\item Efficient implementation of graphs
+\end{itemize}
+\item Already usable in \textcolor{blue}{\href{https://stamp.gitlabpages.inria.fr/trajectories.html}{web-base demonstration}.}
+\begin{itemize}
+\item Extracted code to Ocaml, then compile to JavaScript
+\end{itemize}
+\end{itemize}
+\end{frame}
+\end{document}
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: t
+%%% End: 
diff --git a/documents/Makefile b/documents/Makefile
index 3038b9a..60dd236 100644
--- a/documents/Makefile
+++ b/documents/Makefile
@@ -1,4 +1,4 @@
-all : intro_slides.pdf FHG_paper.pdf
+all : intro_slides.pdf FHG_paper.pdf FHG_slides.pdf
 
 PSFILES=bezier_example.ps bezier_example2.ps cells_spiral.ps \
   collision.ps collision2.ps empty_spiral.ps polygon.ps repair2.ps \
@@ -16,5 +16,8 @@ FHG_paper.pdf : FHG_paper.tex FHG_paper.bib $(PDFFILES) illustration.png
 	pdflatex FHG_paper.tex; bibtex FHG_paper; pdflatex FHG_paper.tex \
         FHG_paper.tex
 
+FHG_slides.pdf : FHG_slides.tex $(PDFFILES)
+	PDFLATEX FHG_slides.tex; pdflatex FHG_slides.tex
+
 $(PDFFILES): %.pdf: %.ps
 	ps2pdf -sPAPERSIZE=a4 $<
diff --git a/documents/collision.ps b/documents/collision.ps
index 03beb133f1b0e0ae17bdacd61347cfc4a547dfe2..ff64f80bc4e2255c1d4d67143ce62439768f26d5 100644
GIT binary patch
delta 143
zcmWm7F$%&k6o6sOW;aJEfwu(Lwg!ie-XuvMwGi{*CGFrH1m7JTy@}WG6i(Lh=NtZ~
z`l`oiYk+(%E<~}1qX8dhgg7P4Jp@XHDMH5aimBwPfd<+&3y(ffB(AznNN=p%_0GT<
pZxb?vnHQ|Am6uklzw6q-K*T*P$YlyH!r<}+hyO=DMzyWT{s(ETFZBQb

delta 112
zcmeyxw1jDb*+fTG5d#GS1w)16)RLm~q~!dZ{30$x%ZW2(S&e|g29pyRC9O=rOaq17
z{Ib-Nd@f@X0|g@xHaAc(HZWH(w1lveON+qr#U(}g*{NLV#ffE;tr%4&h6qhO%?SYb
CDj)~|

diff --git a/documents/collision2.ps b/documents/collision2.ps
index ddf615fdb6e8f51ff6cce2de7edea2da02ac2c9c..9ddbf9f362d5cbebeadca02d0e61cb401261b460 100644
GIT binary patch
literal 589
zcmZ{h%~FIg49D+%ig?(g+VZiCJcXm)91jHw%UH-v)8+Y1x(f<39+;3O`Q@MF^zizw
zo<GLP(c>FVc7}eOyB_DLOa|0i?~+3<COeQ_oH_wEk)mzAQ<>Hv--L^csB&>D4St-(
zr5NyA3L1ZP>5*z^86VICxnXj1B&9)vVK;`MY0+a)S$4zxq2^|z76s>XqkWShIEomg
z+r|1G=sE%RASgR`Aj)dU&iWW<wJFYgj=yNdIbzq5_Bg>vx@f2&uZ}p8DRI%qI9)2v
z5xc5AjJBss>m-J2m~P6WSe7Mm;W53ao|tdS+uz#ZpY_~N*C7V3U0jGG-xoSd7uTg)
c^?8Qk3vxMyJf~~s<+cf#-Ta>6e%x*EKVjpmbpQYW

delta 139
zcmX@ha)fDu*+eH*5d#GS1w)16)RLm~q~!dZ{30$x%ZamO8I30Hkc~1jF;y_KG*HOR
zFH0@S=Q1`kP%ttuRmjQA191(3GDhYISpy?IpmGy)APH4rVgxkYzyQWAE-A{-PUT83
RPAr?u%cMFnRA}NEP5?OwDJK8`


From f2f42a15661add81933a387fcfdd4c1056ec9c14 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 21 May 2024 07:55:09 +0200
Subject: [PATCH 34/43] silence

---
 _CoqProject | 2 --
 1 file changed, 2 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index 73b65ce..517d550 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -28,13 +28,11 @@ theories/cells_alg.v
 theories/door_crossing.v
 theories/events.v
 theories/extraction_command.v
-theories/generic_trajectories.v
 theories/math_comp_complements.v
 theories/no_crossing.v
 theories/opening_cells.v
 theories/points_and_edges.v
 theories/safe_cells.v
-theories/smooth_trajectories.v
 
 -R theories trajectories
 

From 060bc02133cc6b6c923eaf7a02f3aab55af4549d Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Tue, 21 May 2024 08:02:13 +0200
Subject: [PATCH 35/43] changed the order in which the points are are stored in
 right_pts, The proofs go through, but the algorithm is broken, because
 updating right_pts in the case of vertically aligned events is now wrong.

---
 theories/cells.v                |  9 ++---
 theories/cells_alg.v            | 18 +++++-----
 theories/generic_trajectories.v |  4 +--
 theories/safe_cells.v           | 61 +++++++++++++++++++--------------
 4 files changed, 51 insertions(+), 41 deletions(-)

diff --git a/theories/cells.v b/theories/cells.v
index 5cd8421..47d1bdd 100644
--- a/theories/cells.v
+++ b/theories/cells.v
@@ -180,12 +180,13 @@ Lemma no_dup_seq_aux_eq {A : eqType} (s : seq A) :
   no_dup_seq s = no_dup_seq_aux eq_op s.
 Proof. by elim: s => [ | a s /= ->]. Qed.
 
+(* TODO : remove duplication with generic_trajectories *)
 Definition close_cell (p : pt) (c : cell) :=
   match vertical_intersection_point p (low c),
         vertical_intersection_point p (high c) with
   | None, _ | _, None => c
   | Some p1, Some p2 => 
-    Bcell (left_pts c) (no_dup_seq [:: p1; p; p2]) (low c) (high c)
+    Bcell (left_pts c) (no_dup_seq [:: p2; p; p1]) (low c) (high c)
   end.
 
 Definition closing_cells (p : pt) (contact_cells: seq cell) : seq cell :=
@@ -947,9 +948,9 @@ Definition closed_cell_side_limit_ok c :=
    last dummy_pt (left_pts c) === low c,
     right_pts c != [::] :> seq pt,
    all (fun p : pt => p_x p == right_limit c) (right_pts c),
-   sorted <%R [seq p_y p | p <- right_pts c],
-   head dummy_pt (right_pts c) === low c &
-   last dummy_pt (right_pts c) === high c].
+   sorted >%R [seq p_y p | p <- right_pts c],
+   head dummy_pt (right_pts c) === high c &
+   last dummy_pt (right_pts c) === low c].
 
 Lemma closed_right_imp_open c:
   closed_cell_side_limit_ok c -> right_limit c <= open_limit c.
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index ed9680c..96f918f 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -760,18 +760,18 @@ rewrite -?(eq_sym (point e)).
    failed at porting time. *)
 case:ifP (o1) (o2) =>[/eqP q1 |enp1];case:ifP=>[/eqP q2 |enp2];
   rewrite ?q1 ?q2;
-  rewrite -?q1 -?q2 /= ?eqxx ?x2 ?x1 /= => -> -> //; rewrite /= ?andbT.
-- move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] _ eh.
-  have := (under_edge_strict_lower_y x2 (negbT enp2) eh o2).
-  by rewrite q1=> ->//; rewrite andbT.
+  rewrite -?q1 -?q2 /= ?eqxx ?x2 ?x1 /= => -> -> //=; rewrite ?andbT.
 - move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el _.
-  have := (above_edge_strict_higher_y x1 _ el).
-  by apply => //; exact: negbT.
+  have := (above_edge_strict_higher_y x1 (negbT enp2) el).
+  by rewrite /right_limit /= x1 eqxx /=; apply.
+- move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] _ eh.
+  have := (under_edge_strict_lower_y x2 (negbT enp1) eh o2).
+  rewrite /right_limit /= x2 eqxx /=; apply.
 move: x1 x2 ctp=> /eqP/esym x1 /eqP x2 /andP[] el eh.
 rewrite (above_edge_strict_higher_y x1 _ el) //; last first.
   exact: negbT.
-rewrite  (under_edge_strict_lower_y x2 (negbT enp2) eh) //.
-by rewrite -x1 x2 eqxx.
+rewrite  (under_edge_strict_lower_y x2 (negbT enp1) eh) //.
+by rewrite !andbT /right_limit /= -x1 -x2 eqxx.
 Qed.
 
 Lemma closing_cells_side_limit' cc :
@@ -4826,7 +4826,7 @@ rewrite /right_pts/close_cell (pvertE vlcc1) (pvertE vhcc1) /=.
 rewrite !pt_eqE !eqxx /=.
 rewrite (on_pvert eonhcc1) eqxx.
 rewrite -leq; move: (pal).
-rewrite (under_pvert_y vle) -ltNge lt_neqAle=> /andP[] /negbTE -> _.
+rewrite (under_pvert_y vle) -ltNge lt_neqAle eq_sym => /andP[] /negbTE -> _.
 have ppaly : (p_y pp == pvert_y (point e) le) = false.
   apply/negbTE; move: (ppal).
   rewrite (under_pvert_y vpple) -ltNge lt_neqAle eq_sym=> /andP[] + _.
diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index f59366e..0d5a515 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -206,7 +206,7 @@ Definition close_cell (p : pt) (c : cell) :=
         vertical_intersection_point p (high c) with
   | None, _ | _, None => c
   | Some p1, Some p2 =>
-    Bcell (left_pts c) (no_dup_seq (p1 :: p :: p2 :: nil)) (low c) (high c)
+    Bcell (left_pts c) (no_dup_seq (p2 :: p :: p1 :: nil)) (low c) (high c)
   end.
 
 Definition closing_cells (p : pt) (contact_cells: seq cell) : seq cell :=
@@ -469,7 +469,7 @@ Definition cell_safe_exits_left (c : cell) : seq vert_edge :=
 Definition cell_safe_exits_right (c : cell) : seq vert_edge :=
   let lx := p_x (head dummy_pt (right_pts c)) in
   map (fun p => Build_vert_edge lx (p_y (fst p)) (p_y (snd p)))
-   (seq_to_intervals (rev (right_pts c))).
+   (seq_to_intervals (right_pts c)).
 
 (* The index_seq function is a trick to circumvent the absence of a mapi
   function in Coq code.  It makes it possible to build a list of pairs,
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index 59d50d8..1868198 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -95,8 +95,8 @@ Lemma right_limit_right_pt_high_cl (c : cell) :
   right_limit c <= p_x (right_pt (high c)).
 Proof.
 move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
-move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] _ /andP[] _ /andP[] _. 
-by rewrite (eqP (allP rsx _ (last_in_not_nil _ rn0))).
+move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] /andP[] _ /andP[] _ + _.
+by rewrite (eqP (allP rsx _ (head_in_not_nil _ rn0))).
 Qed.
 
 Lemma left_limit_left_pt_low_cl (c : cell) :
@@ -113,8 +113,8 @@ Lemma right_limit_right_pt_low_cl (c : cell) :
   right_limit c <= p_x (right_pt (low c)).
 Proof.
 move=> /andP[] _ /andP[] _ /andP[] _ /andP[] _ /andP[] _.
-move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] /andP[] _ /andP[] _ + _.
-by rewrite (eqP (allP rsx _ (head_in_not_nil _ rn0))).
+move=> /andP[] rn0 /andP[] rsx /andP[] _ /andP[] _ /andP[] _ /andP[] _ +.
+by rewrite (eqP (allP rsx _ (last_in_not_nil _ rn0))).
 Qed.
 
 Lemma right_valid :
@@ -155,8 +155,8 @@ have [vlp vhp] : valid_edge (low c) p /\ valid_edge (high c) p.
   rewrite (eqP (allP lsx _ (@head_in_not_nil pt dummy_pt _ ln0))) in lh.
   rewrite (eqP (allP rsx _ (@last_in_not_nil pt dummy_pt _ rn0))) in rh.
   split; rewrite /valid_edge/generic_trajectories.valid_edge.
-    by rewrite (ltW (le_lt_trans ll midl)) (ltW (lt_le_trans midr rl)).
-  by rewrite (ltW (le_lt_trans lh midl)) (ltW (lt_le_trans midr rh)).
+    by rewrite (ltW (le_lt_trans ll midl)) (ltW (lt_le_trans midr rh)).
+  by rewrite (ltW (le_lt_trans lh midl)) (ltW (lt_le_trans midr rl)).
 rewrite under_onVstrict // negb_or.
 move: noclh=> [abs | noclh]; first by rewrite abs eqxx in dif.
 apply/andP; split; last first.
@@ -198,18 +198,25 @@ have p'on : p' === high c by apply: pvert_on vph.
 rewrite (under_edge_lower_y sx) //.
 have := cok.
 do 5 move=> /andP[] _.
-move=> /andP[] rn0 /andP[] rsx /andP[] srt /andP[] _ lon.
-have p'q : p' = last dummy_pt (right_pts c).
+move=> /andP[] rn0 /andP[] rsx /andP[] srt /andP[] lon _.
+have p'q : p' = head dummy_pt (right_pts c).
   have := on_edge_same_point p'on lon.
-  have /eqP -> := allP rsx _ pin => /(_ erefl) samey.
-  by apply/(@eqP pt); rewrite pt_eqE samey (allP rsx _ pin)/=; exact/eqP.
+  have /eqP -> := allP rsx _ (head_in_not_nil dummy_pt rn0).
+  have /eqP -> := allP rsx _ pin=> /(_ erefl) samey.
+  apply/(@eqP pt).
+  rewrite pt_eqE samey eqxx andbT.
+  rewrite (eqP (allP rsx _ pin))/=.
+  by rewrite (eqP (allP rsx _ (head_in_not_nil dummy_pt rn0))).
 move: rn0 p'q pin srt.
-elim/last_ind: (right_pts c) => [| rpts p2 Ih] // _ p'q pin srt.
-move: pin; rewrite mem_rcons inE => /orP[/eqP -> | pin].
-  by rewrite p'q last_rcons.
-apply: ltW; rewrite p'q last_rcons.
-move: srt; rewrite map_rcons=> srt.
-by have := (allP (sorted_rconsE lt_trans srt)); apply; rewrite map_f.
+elim: (right_pts c) => [| p2 rpts Ih] // rn0 p'1 pin srt.
+move: pin; rewrite inE => /orP[/eqP -> | pin].
+  by rewrite p'1.
+rewrite /= in srt.
+have gt_trans : transitive (>%R : rel R).
+  by move=> x y z xy yz ; apply: (lt_trans yz xy).
+move: (srt); rewrite (path_sortedE gt_trans)=> /andP[] srt' _.
+apply: ltW; rewrite p'1.
+by apply: (allP srt'); rewrite map_f.
 Qed.
 
 Lemma in_bound_closed_valid (c : cell) p :
@@ -292,17 +299,19 @@ rewrite le_eqVlt=> /orP[ /eqP pxq | ].
   rewrite inside_closed'E p'al.
   have c'ok := closed_ok ccl'.
   have /andP[_ /andP[_ /andP[_ /andP[_ /andP[_ ]]] ]] := c'ok.
-  move=> /andP[rn0 /andP[samex /andP[srt /andP[onlow onhigh]]]].
+  move=> /andP[rn0 /andP[samex /andP[srt /andP[onhigh onlow]]]].
   have prlq : p_x p = right_limit c' by apply/eqP/(allP samex).
-  rewrite (under_edge_lower_y prlq onhigh).
-  have -> /= : p_y p <= p_y (last dummy_pt (right_pts c')).
-    elim/last_ind:{-1} (right_pts c') (erefl (right_pts c'))=>[| ps pn _] psq.
-      by rewrite psq in rn0.
-    move: pc'r; rewrite psq mem_rcons inE => /orP[/eqP -> | pps].
-      by rewrite last_rcons.
-    move: (srt); rewrite psq map_rcons => srt'.
-    have := sorted_rconsE lt_trans srt'=> /allP/(_ _ (map_f _ pps))/ltW.
-    by rewrite last_rcons.
+  rewrite (under_edge_lower_y _ onhigh) /=; last first.
+    rewrite (eqP (allP samex _ pc'r)).
+    by rewrite (eqP (allP samex _ (head_in_not_nil dummy_pt rn0))).
+  have -> /= : p_y p <= p_y (head dummy_pt (right_pts c')).
+    case psq : (right_pts c') => [ | p1 ps]; first by rewrite psq in rn0.
+    move: pc'r; rewrite psq inE=> /orP[/eqP -> | pps]; first by [].
+    apply: ltW.
+    have gt_trans : transitive (>%R : rel R).
+      by move=> x y z xy yz; apply: (lt_trans yz xy).
+    move: (srt); rewrite psq /= (path_sortedE gt_trans)=> /andP[] + _.
+    by move=> /allP /(_ _ (map_f _ pps)).
   by rewrite prlq le_refl andbT (non_empty_closed ccl').
 elim: pcc pc1 pcccl highs conn rpcc {lpcc pccn0} =>
   [ | pc2 pcc Ih] pc1 pcccl highs conn rpcc pc1lp.

From 812c7d16e5a2bb11b42e82ec81d020519a9cd86b Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Tue, 21 May 2024 09:52:26 +0200
Subject: [PATCH 36/43] change the order of points in update_closed_cell

---
 theories/cells_alg.v            | 60 +++++++++++++++------------------
 theories/generic_trajectories.v |  4 +--
 2 files changed, 29 insertions(+), 35 deletions(-)

diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index 96f918f..1bb2312 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -643,7 +643,7 @@ Hypothesis closed_right_limit :
 Hypothesis uniq_closed : uniq (rcons cls lstc).
 Hypothesis non_empty_closed :
   {in rcons cls lstc, forall c, exists p, inside_closed' p c}.
-Hypothesis non_empty_right : right_pts lstc != [::] :> seq pt.
+Hypothesis non_empty_right : (1 < size (right_pts lstc))%N.
 Hypothesis uniq_out : uniq (outgoing e).
 Hypothesis high_inj : {in open &, injective high}.
 Hypothesis btm_left : bottom_left_cells_lex open (point e).
@@ -2436,16 +2436,27 @@ rewrite /inside_closed' /set_right_pts /inside_closed_cell /contains_point /=.
 by rewrite /right_limit /= => ->.
 Qed.
 
+Lemma update_closed_cell_keeps_right_limit c pt :
+  (1 < size (right_pts c))%N ->
+  closed_cell_side_limit_ok c ->
+  right_limit (update_closed_cell c pt) =
+  right_limit c.
+Proof.
+move=> non_empty.
+do 5 move=> /andP[_]; move=> /andP[ptsn0 /andP[/allP allx _]].
+rewrite /update_closed_cell /right_limit /=.
+move: non_empty.
+by case: (right_pts c) => [ | hr [ | r2 rpts]].
+Qed.
+
 Lemma inside_closed'_update q1 q:
   inside_closed' q lstc = inside_closed' q (update_closed_cell lstc q1).
 Proof.
 have samer : last dummy_pt (right_pts lstc) =
-             last dummy_pt (belast (head dummy_pt (right_pts lstc))
-                             (behead (right_pts lstc)) ++
-                           [:: q1; last dummy_pt (right_pts lstc)]).
+             last dummy_pt (head dummy_pt (right_pts lstc) :: q1 ::
+                  (behead (right_pts lstc))).
   move: non_empty_right.
-  elim/last_ind : (right_pts lstc) => [ // | rpts lr _] _ /=.
-  by rewrite !last_cat /=.
+  by case : (right_pts lstc) => [ // | hr [ // | r2 rpts]].
 rewrite /update_closed_cell.
 have := inside_closed_set_right_pts q samer.
 rewrite /set_right_pts /=.
@@ -3169,18 +3180,6 @@ rewrite /close_cell (pvertE vlc) (pvertE vhc) /=.
 by case: ifP; case: ifP.
 Qed.
 
-Lemma update_closed_cell_keeps_right_limit c pt :
-  closed_cell_side_limit_ok c ->
-  right_limit (update_closed_cell c pt) =
-  right_limit c.
-Proof.
-do 5 move=> /andP[_]; move=> /andP[ptsn0 /andP[/allP allx _]].
-rewrite /update_closed_cell /right_limit /=.
-elim/last_ind: {-1} (right_pts c) (erefl (right_pts c))
-     ptsn0=> [ // | [ // | pt0 pts] ptf _] ptsq _ /=.
-  by rewrite last_cat.
-Qed.
-
 Lemma step_keeps_closed_to_the_left :
   let s' := step (Bscan fop lsto lop cls lstc lsthe lstx) e in
   {in state_closed_seq s', forall c, right_limit c <= p_x (point e)}.
@@ -3219,12 +3218,9 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
   case uoc_eq : (update_open_cell _ _) => [nos lno].
   rewrite /state_closed_seq /=.
   move=> x; rewrite mem_rcons inE => /orP[/eqP -> | ].
-    rewrite /update_closed_cell /right_limit /=.
-    have := non_empty_right; case pts_eq: (right_pts lstc) => [| p1 rpts] // _.
-    rewrite /= last_cat /=.
-    have /closed_right_limit: lstc \in rcons cls lstc.
-      by rewrite mem_rcons inE eqxx.
-    by rewrite /right_limit pts_eq.
+    rewrite update_closed_cell_keeps_right_limit //; last first.
+      by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
+    by apply: closed_right_limit; rewrite mem_rcons inE eqxx.
   move=> xin.
   suff /closed_right_limit : x \in rcons cls lstc by [].
   by rewrite mem_rcons inE xin orbT.
@@ -3720,15 +3716,16 @@ by rewrite /= ab.
 Qed.
 
 Lemma edge_covered_update_closed_cell g l1 l2 c pt :
+  (1 < size (right_pts c))%N ->
   closed_cell_side_limit_ok c ->
   edge_covered g l1 (rcons l2 c) ->
   edge_covered g l1 (rcons l2 (update_closed_cell c pt)).
 Proof.
-move=> cok ecg.
+move=> szpts cok ecg.
 have lq : left_limit (update_closed_cell c pt) = left_limit c.
   by case: (c).
 have rq : right_limit (update_closed_cell c pt) = right_limit c.
-  by rewrite update_closed_cell_keeps_right_limit.
+  rewrite update_closed_cell_keeps_right_limit //.
 case: ecg => [[oc [pcc [ocP1 [hP [cP [ocin conn]]]]]] | ].
   left; exists oc, (seq_subst pcc c (update_closed_cell c pt)).
   split.
@@ -3873,9 +3870,8 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
     rewrite /state_open_seq /= cats0 /state_closed_seq /=.
     apply: edge_covered_set_left_pts.
       by rewrite /left_limit ptsq.
-    apply: edge_covered_update_closed_cell.
-      by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
-    by exact: ecg.
+    apply: edge_covered_update_closed_cell=> //.
+    by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
   rewrite -/(opening_cells_aux _ _ _ _).
   case oca_eq : (opening_cells_aux _ _ _ _) => [[ | fno nos] lno]  /=.
     have outn0 : fog :: ogs != nil by [].
@@ -3914,7 +3910,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
         rewrite (opening_cells_left oute vlo vho).
           by rewrite pxhere lstxq /left_limit ptsq.
         by rewrite /opening_cells ogq oca_eq mem_rcons !inE eqxx !orbT.
-      apply: edge_covered_update_closed_cell.
+      apply: edge_covered_update_closed_cell=> //.
         by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
       left; exists lno, pcc.
       split; first by [].
@@ -3947,13 +3943,13 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
       by rewrite mem_rcons !inE eqxx !orbT.
     apply: edge_covered_set_left_pts.
       by rewrite left_fno lstxq /left_limit ptsq.
-    apply: edge_covered_update_closed_cell.
+    apply: edge_covered_update_closed_cell=> //.
       by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
     left; exists oc, pcc; repeat (split; first by []); split; last by [].
     by rewrite !(mem_cat, inE); move: inold=> /orP[] ->; rewrite ?orbT.
   move=> [pcc [P1 [P2 [P3 [P4 P5]]]]].
   rewrite /state_open_seq /state_closed_seq /=.
-  apply: edge_covered_update_closed_cell.
+  apply: edge_covered_update_closed_cell => //.
     by apply: (allP close_side_limit); rewrite mem_rcons inE eqxx.
   by right; exists pcc; repeat (split; first by []); done.
 rewrite -/(open_cells_decomposition _ _).
diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 0d5a515..4fc8c30 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -282,9 +282,7 @@ Record scan_state :=
 
 Definition update_closed_cell (c : cell) (p : pt) : cell :=
   let ptseq := right_pts c in
-  let newptseq :=
-    (belast (head dummy_pt ptseq) (behead ptseq)) ++
-    [:: p; seq.last dummy_pt ptseq] in
+  let newptseq := seq.head dummy_pt ptseq :: p :: behead ptseq in
   Bcell (left_pts c) newptseq (low c) (high c).
 
 Definition set_left_pts (c : cell) (l : seq pt) :=

From 0ca511fff970785ef97cbac4258265160722b7e8 Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Wed, 22 May 2024 07:50:36 +0200
Subject: [PATCH 37/43] introducing the invariant for non-general positions
 (with possibly vertically aligned events)

---
 theories/cells_alg.v            | 233 ++++++++++++++++++++++++--------
 theories/generic_trajectories.v |   4 +-
 theories/safe_cells.v           |   2 +
 3 files changed, 181 insertions(+), 58 deletions(-)

diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index 1bb2312..43c91f9 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -22,7 +22,7 @@ Notation p_x := (p_x R).
 Notation p_y := (p_y R).
 Notation Bpt := (Bpt R).
 Notation edge := (edge R).
-Notation event := (event R edge).
+Notation event' := (event R edge).
 Notation outgoing := (outgoing R edge).
 Notation point := (point R edge).
 
@@ -137,7 +137,7 @@ rewrite inE lc0; congr (_ || _).
 by rewrite -map_cons main mem_rcons inE.
 Qed.
 
-Lemma not_bottom_or_top bottom top (ev : event) :
+Lemma not_bottom_or_top bottom top (ev : event') :
   inside_box bottom top (point ev) ->
   out_left_event ev ->
   {in outgoing ev, forall g, g \notin [:: bottom; top]}.
@@ -574,7 +574,7 @@ Qed.
 Section step.
 
 
-Variable e : event.
+Variable e : event'.
 Variable fop : seq cell.
 Variable lsto : cell.
 Variable lop : seq cell.
@@ -582,7 +582,7 @@ Variable cls : seq cell.
 Variable lstc :  cell.
 Variable lsthe : edge.
 Variable lstx : R.
-Variable future_events : seq event.
+Variable future_events : seq event'.
 Variable p : pt.
 
 Let open := (fop ++ lsto :: lop).
@@ -5019,8 +5019,8 @@ Lemma cell_edges_start bottom top :
   cell_edges [::(start_open_cell bottom top)] = [:: bottom; top].
 Proof. by []. Qed.
 
-Record common_general_position_invariant bottom top edge_set s
-  (events : seq event) :=
+Record common_invariant bottom top edge_set s
+  (events : seq event') :=
   { inv1 : inv1_seq bottom top events (state_open_seq s);
    lstx_eq : lst_x _ _ s = left_limit (lst_open s);
    high_lsto_eq : high (lst_open s) = lst_high _ _ s;
@@ -5032,11 +5032,23 @@ Record common_general_position_invariant bottom top edge_set s
            [seq point x | x <- events];
    lex_events : sorted (@lexPtEv _) events;
    sides_ok : all open_cell_side_limit_ok (state_open_seq s);
+}.
+
+Record common_general_position_invariant bottom top edge_set s
+  (events : seq event') :=
+  { gcomm : common_invariant bottom top edge_set s events;
    general_pos :
      all (fun ev => lst_x _ _ s < p_x (point ev)) events &&
      sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) events;
 }.
 
+Record common_non_gp_invariant bottom top edge_set s (events : seq event') :=
+  { ngcomm : common_invariant bottom top edge_set s events;
+    lst_side_lex : 
+        (1 < size (left_pts (lst_open s)))%N &&
+        path (@lexPt _) (nth dummy_pt (left_pts (lst_open s)) 1)
+         [seq point e | e <- events]}.
+
 (* This lemma only provides a partial correctness statement in the case
   where the events are never aligned vertically.  This condition is
   expressed by the very first hypothesis.  TODO: it relies on the assumption
@@ -5048,7 +5060,7 @@ Record common_general_position_invariant bottom top edge_set s
   cells, here named "open", should be reduced to only one element. *)
 Record disjoint_general_position_invariant (bottom top : edge)
  (edge_set : seq edge)
- (s : scan_state) (events : seq event) :=
+ (s : scan_state) (events : seq event') :=
  { op_cl_dis :
      {in state_open_seq s & state_closed_seq s,
        disjoint_open_closed_cells R};
@@ -5065,7 +5077,7 @@ Record disjoint_general_position_invariant (bottom top : edge)
 Definition dummy_state :=
   Bscan [::] dummy_cell [::] [::] dummy_cell dummy_edge 0.
 
-Definition initial_state bottom top (events : seq event) :=
+Definition initial_state bottom top (events : seq event') :=
   match events with
   | [::] => dummy_state
   | ev :: future_events =>
@@ -5078,7 +5090,7 @@ Definition initial_state bottom top (events : seq event) :=
   end.
 
 Lemma initial_intermediate bottom top s events :
-  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+(*   sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events -> *)
   bottom <| top ->
   (* TODO: rephrase this statement in a statement that easier to understand. *)
   open_cell_side_limit_ok (start_open_cell bottom top) ->
@@ -5110,7 +5122,7 @@ Lemma initial_intermediate bottom top s events :
   pairwise (@edge_below _) (bottom :: [seq high c | c <- [:: op0]]) /\
   sorted (@lexPtEv _) (behead events).
 Proof.
-move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle.
+move=> boxwf startok nocs' evin lexev evsub out_evs cle.
 have nocs : {in bottom :: top :: s &, no_crossing R}.
   by apply: inter_at_ext_no_crossing.
 case evsq : events => [ | ev future_events]; [by [] | move=> _ /=].
@@ -5157,8 +5169,7 @@ do 15 (split; first by []).
 by [].
 Qed.
 
-Lemma initial_common_general_position_invariant bottom top s events:
-  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+Lemma initial_common_invariant bottom top s events:
   bottom <| top ->
   (* TODO: rephrase this statement in a statement that easier to understand. *)
   open_cell_side_limit_ok (start_open_cell bottom top) ->
@@ -5169,14 +5180,12 @@ Lemma initial_common_general_position_invariant bottom top s events:
   {in events, forall ev, out_left_event ev} ->
   close_edges_from_events events ->
   events != [::] ->
-  common_general_position_invariant bottom top s
-    (initial_state bottom top events)
-    (* (head (dummy_event _) events) *) (behead events).
+  common_invariant bottom top s
+    (initial_state bottom top events) (behead events).
 Proof.
-move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
+move=> boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
 have :=
-  initial_intermediate ltev boxwf startok nocs' evin lexev evsub out_evs cle
-    evsn0.
+  initial_intermediate boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
 case evsq : events evsn0 => [ | ev future_events]; [by [] | move=> _].
 move=> [op0sok [cbtom0 [adj0 /=
            [sval0 [rf0 [inbox0 [cle0 [oute0 [clae0 [vb 
@@ -5230,15 +5239,10 @@ rewrite -cats1 in edges_sub1 sval'.
 have lstx1op : lst_x _ _ state1 = left_limit (lst_open state1).
   have := opening_cells_left oute vb vt; rewrite /opening_cells.
   by rewrite oca_eq st1q => -> //=; rewrite mem_rcons inE eqxx.
-have sh1 : all (fun ev => lst_x _ _ state1 < p_x (point ev)) future_events &&
-          sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) future_events.
-  move: ltev; rewrite evsq /= path_sortedE /=; last first.
-    by move=> x y z; apply: lt_trans.
-  by rewrite st1q.
 have he1q' : high (lst_open state1) = lst_high _ _ state1.
   rewrite st1q /=.
   by have := opening_cells_aux_high_last vb vt oute'; rewrite oca_eq.
-move: lstx1op he1q' sh1; rewrite st1q=> lstx1op he1q' sh1.
+move: lstx1op he1q'; rewrite st1q=> lstx1op he1q'.
 have oks1 : all open_cell_side_limit_ok (nos ++ [:: lno]).
   have := pin => /andP[] /andP[] /underWC pal puh _.
   have := opening_cells_side_limit vb vt pal puh oute.
@@ -5246,6 +5250,121 @@ have oks1 : all open_cell_side_limit_ok (nos ++ [:: lno]).
 by constructor.
 Qed.
 
+Lemma initial_common_general_position_invariant bottom top s events:
+  sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
+  bottom <| top ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  sorted (@lexPtEv _) events ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  close_edges_from_events events ->
+  events != [::] ->
+  common_general_position_invariant bottom top s
+    (initial_state bottom top events) (behead events).
+Proof.
+move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
+have ici := initial_common_invariant boxwf startok nocs' evin lexev evsub
+            out_evs cle evsn0.
+constructor; first by exact: ici.
+case evsq :  events => [ | ev1 evs] //.
+move: ltev; rewrite evsq /=.
+rewrite path_sortedE; last by  move=> x y z; apply: lt_trans.
+move=> /andP[] + ->; rewrite andbT.
+rewrite /initial_state /=.
+by case oca_eq:  (opening_cells_aux _ _ _ _).
+Qed.
+
+Lemma opening_cells_aux_event le he p gs nos lno :
+  valid_edge le p ->
+  valid_edge he p ->
+  p >>= le ->
+  p <<< he ->
+  {in gs, forall g, left_pt g == p} ->
+  opening_cells_aux p gs le he = (nos, lno) ->
+  (1 < size (left_pts lno))%N /\
+  nth dummy_pt (left_pts lno) 1 = p.
+Proof.
+move=> vle vhe; elim: gs le vle nos lno=>
+   [ | g1 gs Ih] le vle nos lno pal puh oute /=.
+  rewrite -/(vertical_intersection_point p le) (pvertE vle).
+  rewrite -/(vertical_intersection_point p he) (pvertE vhe).
+  case: ifP=> [/eqP abs1 | dif1 //]; last first.
+    case: ifP=> [/eqP abs2 | dif2 //]; last first.
+      by move=> [] _ <- /=.
+    by move=> [] _ <- /=; split; [ | rewrite -abs2].
+  move=> [] _.    
+  rewrite (strict_under_pvert_y vhe) ltNge in puh.
+  move: puh => /negP; case.
+  by rewrite on_pvert // -abs1 pvert_on.
+case oca_eq : (opening_cells_aux p gs g1 he) => [no1 lno1].
+rewrite -/(vertical_intersection_point p le) (pvertE vle).
+have g1q : left_pt g1 = p.
+  have g1in : g1 \in g1 :: gs by rewrite inE eqxx.
+  by rewrite (eqP (oute g1 g1in)).
+have vg : valid_edge g1 p.
+  by rewrite -g1q valid_edge_left.
+case: ifP => [/eqP ponl | dif]; last first.
+  move=> [] A <-.
+  apply: (Ih g1 vg no1)=> //.
+    by rewrite -g1q; apply: left_pt_above.
+  by move=> g gin; apply: oute; rewrite inE gin orbT.
+move=> [] _ <-.
+apply: (Ih g1 vg no1)=> //.
+  by rewrite -g1q; apply: left_pt_above.
+by move=> g gin; apply: oute; rewrite inE gin orbT.
+Qed.
+
+Lemma sorted_cat_rcons [T : Type] (rel : rel T) s1 e s2 :
+  sorted rel ((rcons s1 e) ++ s2) =
+  sorted rel (rcons s1 e) && path rel e s2.
+Proof.
+elim: s1 => [ | e1 s1 Ih] //.
+by rewrite /= cat_path last_rcons.
+Qed.
+
+Lemma initial_common_non_gp_invariant bottom top s events:
+  bottom <| top ->
+  (* TODO: rephrase this statement in a statement that easier to understand. *)
+  open_cell_side_limit_ok (start_open_cell bottom top) ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  all (inside_box bottom top) [seq point e | e <- events] ->
+  sorted (@lexPtEv _) events ->
+  {subset flatten [seq outgoing e | e <- events] <= s} ->
+  {in events, forall ev, out_left_event ev} ->
+  close_edges_from_events events ->
+  events != [::] ->
+  common_non_gp_invariant bottom top s
+    (initial_state bottom top events) (behead events).
+Proof.
+move=> boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
+have ici := initial_common_invariant boxwf startok nocs' evin lexev evsub
+            out_evs cle evsn0.
+constructor; first by exact: ici.
+case evsq :  events evsn0 => [ | ev1 evs] //= _.
+case oca_eq: (opening_cells_aux _ _ _ _) => [nos lno].
+have oute1 : out_left_event ev1.
+  by apply: out_evs; rewrite evsq inE eqxx.
+have oute1' : {in sort (@edge_below _) (outgoing ev1), forall g,
+                  left_pt g == point ev1}.
+  by move=> g; rewrite mem_sort; apply: oute1.
+have := sides_ok ici.
+rewrite /initial_state evsq oca_eq /state_open_seq/= all_cat /= andbT.
+move=> /andP[] _; rewrite /open_cell_side_limit_ok.
+move=> /andP[] _ /andP[] samex /andP[] srt _.
+have ev1in : inside_box bottom top (point ev1).
+  by apply: (allP evin); rewrite evsq map_f // inE eqxx.
+have [vb vt] : valid_edge bottom (point ev1) /\ valid_edge top (point ev1).
+  by rewrite !(inside_box_valid_bottom_top ev1in) // !inE eqxx ?orbT.
+move: (ev1in); rewrite /inside_box=> /andP[] /andP[] /underWC ev1a ev1u _.
+have [] := opening_cells_aux_event vb vt ev1a ev1u oute1' oca_eq.
+case lptsq : (left_pts lno) => [ | p1 [ | p2 ps]] //= _ p2q.
+rewrite p2q path_map.
+by move: lexev; rewrite evsq /=.
+Qed.
+
 Lemma initial_disjoint_general_position_invariant
     bottom top s events:
    sorted (fun e1 e2=> p_x (point e1) < p_x (point e2)) events ->
@@ -5266,7 +5385,7 @@ Proof.
 move=> ltev boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
 have := initial_common_general_position_invariant ltev boxwf startok
   nocs' evin lexev evsub out_evs cle evsn0.
-have := initial_intermediate ltev boxwf startok nocs' evin lexev evsub
+have := initial_intermediate boxwf startok nocs' evin lexev evsub
    out_evs cle evsn0.
 move: evsn0; case evsq : events => [ | ev evs];[by [] | move=> _].
 lazy zeta; rewrite [head _ _]/= [behead _]/=.
@@ -5275,7 +5394,7 @@ move=> -[] op0sok [cbtom0 [adj0 [sval0 [rf0 [inbox0
 have evins : ev \in events by rewrite evsq inE eqxx.
 rewrite /initial_state /state_open_seq/state_closed_seq/= => Cinv.
 case oca_eq:  (opening_cells_aux _ _ _ _) Cinv => [nos lno] Cinv.
-move: (Cinv)=> -[]; rewrite /state_open_seq/state_closed_seq/=.
+move: (Cinv)=> -[] []; rewrite /state_open_seq/state_closed_seq/=.
 move=> inv1 pxe hlno edges_sub1 cle1 oute1 inbox1 lexevs sok1 gen_pos.
 set op0 := start_open_cell bottom top.
 have op0_cl0_dis : {in [:: op0] & [::], disjoint_open_closed_cells R} by [].
@@ -5323,7 +5442,7 @@ Lemma simple_step_common_general_position_invariant
     evs.
 Proof.
 move=> boxwf nocs' inbox_s oe.
-move=> []; rewrite /state_open_seq/state_closed_seq/=.
+move=> [] []; rewrite /state_open_seq/state_closed_seq/=.
 move=> inv lstxq lstheq sub_edges cle  out_es /[dup] inbox0.
 move=> /andP[] inbox_e inbox_es.
 move=> lexev oks /andP[] lstxlt ltev'.
@@ -5404,7 +5523,7 @@ Proof.
 move=> boxwf nocs' inbox_s oe.
 move=> []; rewrite /state_open_seq/state_closed_seq/=.
 move=> oc_dis c_dis Cinv pw rl.
-have := Cinv=> -[]; rewrite /state_open_seq/state_closed_seq/=.
+have := Cinv=> -[] []; rewrite /state_open_seq/state_closed_seq/=.
 move=> inv1 lstxq lstheq sub_edges cle out_es inbox_es lexev oks gen_pos.
 have := inv1 => -[] clae [] []; first by [].
 move=> sval []adj []cbtom rfo.
@@ -5459,7 +5578,7 @@ Definition start :=
   start R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1 edge
   (@unsafe_Bedge _) (@left_pt _) (@right_pt _).
 
-Lemma start_eq_initial (bottom top : edge) (ev : event) :
+Lemma start_eq_initial (bottom top : edge) (ev : event') :
   start ev bottom top = initial_state bottom top [:: ev].
 Proof. by []. Qed.
 
@@ -5526,7 +5645,7 @@ move=> {evs ltev evin lexev evsub out_evs cle evsn0}.
 move=> [fop lsto lop cls lstc lsthe lstx].
 case; set ops' := (state_open_seq _); set (cls' := state_closed_seq _).
 rewrite /=.
-move=> dis_open_closed dis_cl /[dup] Cinv [] inv1 lstxq lstheq sub_edges.
+move=> dis_open_closed dis_cl /[dup] Cinv [] [] inv1 lstxq lstheq sub_edges.
 move=> /[dup] cle /andP[cl_e_fut' cle'] out_fut'.
 move=> /[dup]  inbox_all_events' /andP[inbox_e inbox_all_events] lexevs oks.
 move=> /andP[] /andP[] lstxlte lstx_fut' ltfut' edges_pairwise cl_at_left.
@@ -5551,8 +5670,8 @@ by apply.
 Qed.
 
 Record edge_covered_general_position_invariant (bottom top : edge)
- (edge_set : seq edge) (processed_set : seq event)
- (s : scan_state) (events : seq event) :=
+ (edge_set : seq edge) (processed_set : seq event')
+ (s : scan_state) (events : seq event') :=
  { edge_covered_ec : {in processed_set, forall e,
        {in outgoing e, forall g,
        edge_covered g (state_open_seq s) (state_closed_seq s)}};
@@ -5618,7 +5737,7 @@ Proof.
 move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es
   uniq_out_es evsn0.
 rewrite /initial_state.
-have := initial_intermediate gen_pos wf startok nocs' inbox_es lexev sub_es
+have := initial_intermediate wf startok nocs' inbox_es lexev sub_es
   out_es cle evsn0.
 have := initial_common_general_position_invariant gen_pos wf startok nocs'
   inbox_es lexev sub_es out_es cle evsn0.
@@ -5636,7 +5755,7 @@ have cle0 : close_edges_from_events (e :: evs) by rewrite -evsq.
 move: inbox_es; rewrite evsq=> inbox_es.
 move: Cinv; rewrite/initial_state oca_eq/state_open_seq/state_closed_seq/=.
 move=> /[dup] Cinv; rewrite /state_open_seq/state_closed_seq /=.
-move=> -[]; rewrite /state_open_seq/state_closed_seq /=.
+move=> -[] []; rewrite /state_open_seq/state_closed_seq /=.
 move=> inv1 px1 lstheq1 sub1 _ _ _ _ oks1 lexpt1.
 have [clae1 [pre_sval [adj1 [cbtom1 rf1]]]] := inv1.
 set op0 := start_open_cell bottom top.
@@ -5733,7 +5852,7 @@ have nocs : {in bottom :: top :: s &, no_crossing R}.
   by apply: inter_at_ext_no_crossing.
 set st := Bscan _ _ _ _ _ _ _.
 move=> oe.
-move=> [] covered p_covered /[dup] Cinv [] /[dup] inv_s [] clae.
+move=> [] covered p_covered /[dup] Cinv [] [] /[dup] inv_s [] clae.
 move=> - [] []; first by [].
 rewrite /state_open_seq/state_closed_seq /= => sval [] adj [] cbtom rfo.
 move=> lstxq lstheq sub_edges cle out_es.
@@ -5914,8 +6033,8 @@ by have := simple_step_edge_covered_general_position boxwf nocs'
 Qed.
 
 Record safe_side_general_position_invariant (bottom top : edge)
- (edge_set : seq edge) (processed_set : seq event)
- (s : scan_state) (events : seq event) :=
+ (edge_set : seq edge) (processed_set : seq event')
+ (s : scan_state) (events : seq event') :=
  { disjoint_ss :
      disjoint_general_position_invariant bottom top edge_set s events;
    covered_ss :
@@ -5959,7 +6078,7 @@ Record safe_side_general_position_invariant (bottom top : edge)
          p != point e :> pt};
 }.
 
-Lemma events_to_edges_rcons evs (e : event) :
+Lemma events_to_edges_rcons evs (e : event') :
   events_to_edges (rcons evs e) = events_to_edges evs ++ outgoing e.
 Proof. by rewrite /events_to_edges /= map_rcons flatten_rcons. Qed.
 
@@ -6021,7 +6140,7 @@ Lemma initial_safe_side_general_position bottom top s events:
 Proof.
 move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es 
   uniq_out_es evsn0.
-have := initial_intermediate gen_pos wf startok nocs' inbox_es lexev sub_es
+have := initial_intermediate wf startok nocs' inbox_es lexev sub_es
   out_es cle evsn0.
 have := initial_disjoint_general_position_invariant gen_pos wf startok
   nocs' inbox_es lexev sub_es out_es cle evsn0.
@@ -6142,7 +6261,7 @@ have op_no_event : {in [:: ev] & nos ++ [:: lno],
   have := opening_cells_in vb0 vt0 oute; rewrite /opening_cells oca_eq pev.
   by apply.
 have lt_p_ev :
-  {in [:: ev] & evs, forall e1 e2 : event, p_x (point e1) < p_x (point e2)}.
+  {in [:: ev] & evs, forall e1 e2 : event', p_x (point e1) < p_x (point e2)}.
   by move=> e1 e2; rewrite inE => /eqP ->; apply: lte.
 have ll_o_b : 
   {in nos ++ [:: lno], forall c, 
@@ -6253,7 +6372,7 @@ elim=> [ | {evsq oca_eq istate invss}ev {req}future_events Ih] op cl st p_set.
         rewrite (eq_all_r (_ : lstc :: cls =i rcons cls lstc)) //.
         by move=> c; rewrite mem_rcons.
       (* TODO : find a place for this as a lemma. *)
-      have [[] + + _ _ _ _ _ _ _ + _] := c_inv; rewrite /state_open_seq/=.
+      have [[] [] + + _ _ _ _ _ _ _ + _] := c_inv; rewrite /state_open_seq/=.
       rewrite /state_open_seq/= /close_alive_edges => clae.
       move=> [] _ [] adj [] cbtom rfo _.
       have htop : {in fop ++ lsto :: lop, forall c, high c = top}.
@@ -6314,9 +6433,9 @@ rewrite -/(opening_cells_aux _ _ _ _).
 case oca_eq : (opening_cells_aux _ _ _ _) => [{}nos {}lno].
 rewrite -(cat_rcons ev).
 apply: Ih.
-have [clae [pre_sval [adj [cbtom rfo]]]] := inv1 c_inv.
+have [clae [pre_sval [adj [cbtom rfo]]]] := inv1 (gcomm c_inv).
 move: pre_sval=> [| sval]; first by[].
-have inbox_es := inbox_events c_inv.
+have inbox_es := inbox_events (gcomm c_inv).
 have inbox_e : inside_box bottom top (point ev) by move: inbox_es=>/andP[].
 move: (oe); rewrite (_ : fop ++ lsto :: lop = state_open_seq st); last first.
   by rewrite stq.
@@ -6329,7 +6448,7 @@ have [{}pal {}puh vl vp nc]:=
   decomposition_connect_properties rfo sval adj cbtom
     (inside_box_between inbox_e) oe'.
 have oute : out_left_event ev.
-  by apply: (out_events c_inv); rewrite inE eqxx.
+  by apply: (out_events (gcomm c_inv)); rewrite inE eqxx.
 have oute' :
   {in (sort (@edge_below _) (outgoing ev)), forall g, left_pt g == point ev}.
   by move=> g; rewrite mem_sort; apply: oute.
@@ -6371,7 +6490,7 @@ have subc' :
   move=> g; rewrite /state_closed_seq/= -cats1 -catA /= -cat_rcons.
   rewrite cell_edges_cat mem_cat=> /orP[gold | ].
     by apply: subc; rewrite stq.
-  have subo := edges_sub c_inv.
+  have subo := edges_sub (gcomm c_inv).
   rewrite cats1 -map_rcons mem_cat=> /orP[] /mapP[c'] /mapP[c2 c2in ->] ->.
     have [-> _ _] := close_cell_preserve_3sides (point ev) c2.
     apply: subo; rewrite !mem_cat; apply/orP; left; apply/orP; left.
@@ -6382,7 +6501,7 @@ have subc' :
 (* Proving that open cells have a left side that is smaller than any
    event first coordinate. *)
 have loplte : {in state_open_seq rstate & future_events,
-    forall (c : cell) (e : event), left_limit c < p_x (point e)}.
+    forall (c : cell) (e : event'), left_limit c < p_x (point e)}.
   move=> c e; rewrite /state_open_seq/= -catA -cat_rcons => cin ein.
   move: cin; rewrite !mem_cat orbCA => /orP[ | cold ]; last first.
     apply: lolt; first by rewrite ocd -cat_rcons !mem_cat orbCA cold orbT.
@@ -6418,16 +6537,16 @@ have clok' : all (@closed_cell_side_limit_ok _) (state_closed_seq rstate).
     by rewrite ocd -cat_rcons !mem_cat c'in orbT.
   have /(allP sval) /= /andP[vlc' vhc'] := c'in'.
   have c'ok : open_cell_side_limit_ok c'.
-    by apply: (allP (sides_ok c_inv)).
+    by apply: (allP (sides_ok (gcomm c_inv))).
   by apply close_cell_ok.
 (* proving a right_limit stronger invariant. *)
 have rllte :   {in state_closed_seq rstate & future_events,
-    forall (c : cell) (e : event), right_limit c < p_x (point e)}.
+    forall (c : cell) (e : event'), right_limit c < p_x (point e)}.
   rewrite /state_closed_seq/=.
   move=> c e cin ein.
   move: cin; rewrite -cats1 -catA /= -cat_rcons mem_cat=> /orP[cold | cnew].
     by apply: rl; rewrite ?stq // inE ein orbT.
-  have in_es := inbox_events c_inv.
+  have in_es := inbox_events (gcomm c_inv).
   have := closing_cells_to_the_left in_es rfo cbtom adj sval.
   rewrite stq=> /(_ _ _ _ _ _ _ oe)=> -[] main1 main2.
   have eve : p_x (point ev) < p_x (point e).
@@ -6478,7 +6597,7 @@ have cl_safe_edge :
     have cin' : c \in state_closed_seq st by rewrite stq.
     have abs := rl _ _ cin' (mem_head _ _).
     move=> /andP[] _ /andP[] + _.
-    have := out_events c_inv (mem_head _ _) gnew=> /eqP ->.
+    have := out_events (gcomm c_inv) (mem_head _ _) gnew=> /eqP ->.
   (* TODO : have the same condition, but for the right side of closed cells. *)
     suff prl : p_x p <= right_limit c.
       rewrite leNgt=> /negP; apply.
@@ -6544,7 +6663,8 @@ have cl_safe_edge :
     by have [-> -> _] := close_cell_preserve_3sides (point ev) c' => ->.
   have : p >>= low opc by move: cnt=> /andP[].
   rewrite strict_nonAunder // negb_and negbK=> /orP[ | stricter]; last first.
-    have := disoc adj pw (sides_ok c_inv)=> /(_ opc c' opco c'in') [ab' | ].
+    have := disoc adj pw (sides_ok (gcomm c_inv)).
+    move=> /(_ opc c' opco c'in') [ab' | ].
       by move: puhc'; rewrite strict_nonAunder // -ab' opch abs.
     move=> /(_ p) + ; move=>/negP.
     rewrite inside_open'E stricter valid_open_limit //.
@@ -6574,13 +6694,14 @@ have cl_safe_edge :
     by move: palc'=> /[swap] => ->.
   have ldifh : low opc != high opc by apply: d_e; rewrite mem_cat opco.
   have low_opc_s : low opc \in [:: bottom, top & s].
-    by apply: (edges_sub c_inv); rewrite !mem_cat map_f.
+    by apply: (edges_sub (gcomm c_inv)); rewrite !mem_cat map_f.
   have high_opc_s : high opc \in [:: bottom, top & s].
-    by apply: (edges_sub c_inv); rewrite !mem_cat map_f ?orbT.
+    by apply: (edges_sub (gcomm c_inv)); rewrite !mem_cat map_f ?orbT.
   have := nocs' (low opc) (high opc) low_opc_s high_opc_s.
   move=> [Q | ]; first by rewrite Q eqxx in ldifh.
   have ponh : p === high opc by rewrite opch.
-  have opcok : open_cell_side_limit_ok opc by apply: (allP (sides_ok c_inv)).
+  have opcok : open_cell_side_limit_ok opc.
+    by apply: (allP (sides_ok (gcomm c_inv))).
   move=> /(_ _ ponl ponh); rewrite !inE=> /orP[/eqP pleft | /eqP].
     have : left_limit opc < p_x p.
       by rewrite samex; apply: lolt; rewrite // inE eqxx.
@@ -6673,7 +6794,7 @@ have cl_safe_event :
   by rewrite -abs pxq lt_irreflexive.
 have op_safe_event :
 {in rcons p_set ev & state_open_seq rstate,
-    forall (e : event) (c : cell) (p : pt),
+    forall (e : event') (c : cell) (p : pt),
     in_safe_side_left p c -> p != point e}.
   move=> e c ein; rewrite /rstate/state_open_seq/=.
   rewrite -catA -cat_rcons !mem_cat orbCA=> /orP[cnew | cold]; last first.
@@ -6709,7 +6830,7 @@ have rf_closed1 : {in state_closed_seq rstate, forall c, low c <| high c}.
     by apply: rf_cl; rewrite /state_closed_seq stq/=.
   rewrite cats1 -map_rcons=> /mapP[c' c'in ->].
   have [-> -> _] := close_cell_preserve_3sides (point ev) c'.
-  have [+ _ _ _ _ _ _ _ _ _] := c_inv.
+  have [[] + _ _ _ _ _ _ _ _ _] := c_inv.
   move=> [] _ [] _ [] _ [] _ /allP; apply.
   by rewrite ocd -cat_rcons !mem_cat c'in orbT.
 have lo_lb' : {in state_open_seq rstate, forall c,
diff --git a/theories/generic_trajectories.v b/theories/generic_trajectories.v
index 4fc8c30..8ea815c 100644
--- a/theories/generic_trajectories.v
+++ b/theories/generic_trajectories.v
@@ -526,9 +526,9 @@ Definition one_door_neighbors
           indexed_doors)
   end.
 
-Definition left_limit (c : cell) := p_x (seq.last dummy_pt (left_pts c)).
+Definition left_limit (c : cell) := p_x (seq.head dummy_pt (left_pts c)).
 
-Definition right_limit c := p_x (seq.last dummy_pt (right_pts c)).
+Definition right_limit c := p_x (seq.head dummy_pt (right_pts c)).
 
 Definition cmp_option := cmp_option _ R_ltb.
 
diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index 1868198..d1acd96 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -212,6 +212,7 @@ elim: (right_pts c) => [| p2 rpts Ih] // rn0 p'1 pin srt.
 move: pin; rewrite inE => /orP[/eqP -> | pin].
   by rewrite p'1.
 rewrite /= in srt.
+(* TODO : use rev_trans here. *)
 have gt_trans : transitive (>%R : rel R).
   by move=> x y z xy yz ; apply: (lt_trans yz xy).
 move: (srt); rewrite (path_sortedE gt_trans)=> /andP[] srt' _.
@@ -308,6 +309,7 @@ rewrite le_eqVlt=> /orP[ /eqP pxq | ].
     case psq : (right_pts c') => [ | p1 ps]; first by rewrite psq in rn0.
     move: pc'r; rewrite psq inE=> /orP[/eqP -> | pps]; first by [].
     apply: ltW.
+    (* TODO : use rev_trans here. *)
     have gt_trans : transitive (>%R : rel R).
       by move=> x y z xy yz; apply: (lt_trans yz xy).
     move: (srt); rewrite psq /= (path_sortedE gt_trans)=> /andP[] + _.

From dde8ba269322ff5fd07807b4c58d833e4a914502 Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Wed, 31 Jul 2024 16:17:16 +0200
Subject: [PATCH 38/43] adds information about publications

---
 .github/workflows/docker-action.yml |  5 ++---
 README.md                           |  9 ++++++---
 meta.yml                            | 13 ++++++-------
 3 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml
index 41f0932..052158a 100644
--- a/.github/workflows/docker-action.yml
+++ b/.github/workflows/docker-action.yml
@@ -17,17 +17,16 @@ jobs:
     strategy:
       matrix:
         image:
-          - 'mathcomp/mathcomp:2.2.0-coq-8.17'
-          - 'mathcomp/mathcomp:2.2.0-coq-8.18'
           - 'mathcomp/mathcomp:2.2.0-coq-8.19'
       fail-fast: false
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
       - uses: coq-community/docker-coq-action@v1
         with:
           opam_file: 'coq-mathcomp-trajectories.opam'
           custom_image: ${{ matrix.image }}
 
+
 # See also:
 # https://github.com/coq-community/docker-coq-action#readme
 # https://github.com/erikmd/docker-coq-github-action-demo
diff --git a/README.md b/README.md
index b3c41bb..06103b0 100644
--- a/README.md
+++ b/README.md
@@ -6,8 +6,8 @@ Follow the instructions on https://github.com/coq-community/templates to regener
 
 [![Docker CI][docker-action-shield]][docker-action-link]
 
-[docker-action-shield]: https://github.com/math-comp/trajectories/workflows/Docker%20CI/badge.svg?branch=master
-[docker-action-link]: https://github.com/math-comp/trajectories/actions?query=workflow:"Docker%20CI"
+[docker-action-shield]: https://github.com/math-comp/trajectories/actions/workflows/docker-action.yml/badge.svg?branch=master
+[docker-action-link]: https://github.com/math-comp/trajectories/actions/workflows/docker-action.yml
 
 
 
@@ -33,7 +33,7 @@ TODO
   - [Infotheo 0.7.0 of later](https://github.com/affeldt-aist/infotheo)
 - Coq namespace: `mathcomp.trajectories`
 - Related publication(s):
-  - [TODO](TODO) doi:[TODO](https://doi.org/TODO)
+  - [Safe Smooth Paths between Straight Line Obstacles](https://inria.hal.science/hal-04312815) doi:[https://doi.org/10.1007/978-3-031-61716-4_3](https://doi.org/https://doi.org/10.1007/978-3-031-61716-4_3)
 
 ## Building and installation instructions
 
@@ -70,6 +70,9 @@ references:
   https://hal.inria.fr/inria-00503017v2/document
 - Theorem of three circles in Coq (2013)
   https://arxiv.org/abs/1306.0783
+- Safe Smooth Paths between straight line obstacles
+  https://inria.hal.science/hal-04312815
+  https://link.springer.com/chapter/10.1007/978-3-031-61716-4_3
 
 ## Development information
 
diff --git a/meta.yml b/meta.yml
index 7057cff..60a7716 100644
--- a/meta.yml
+++ b/meta.yml
@@ -31,10 +31,6 @@ supported_coq_versions:
   opam: '{ (>= "8.17" & < "8.20~") | (= "dev") }'
 
 tested_coq_opam_versions:
-- version: '2.2.0-coq-8.17'
-  repo: 'mathcomp/mathcomp'
-- version: '2.2.0-coq-8.18'
-  repo: 'mathcomp/mathcomp'
 - version: '2.2.0-coq-8.19'
   repo: 'mathcomp/mathcomp'
 
@@ -94,9 +90,9 @@ categories:
 - name: Mathematics/Real Calculus and Topology
 
 publications:
-- pub_url: TODO
-  pub_title:  TODO
-  pub_doi: TODO
+- pub_url: https://inria.hal.science/hal-04312815
+  pub_title:  Safe Smooth Paths between Straight Line Obstacles
+  pub_doi: https://doi.org/10.1007/978-3-031-61716-4_3
 
 documentation: |-
   ## Disclaimer
@@ -114,6 +110,9 @@ documentation: |-
     https://hal.inria.fr/inria-00503017v2/document
   - Theorem of three circles in Coq (2013)
     https://arxiv.org/abs/1306.0783
+  - Safe Smooth Paths between straight line obstacles
+    https://inria.hal.science/hal-04312815
+    https://link.springer.com/chapter/10.1007/978-3-031-61716-4_3
 
   ## Development information
 

From ec8991e68cfa618305e54f8fb228ad57087c372a Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Mon, 21 Oct 2024 14:16:02 +0200
Subject: [PATCH 39/43] attempt with more notations

---
 theories/safe_cells.v | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/theories/safe_cells.v b/theories/safe_cells.v
index d1acd96..f3aaf4b 100644
--- a/theories/safe_cells.v
+++ b/theories/safe_cells.v
@@ -29,7 +29,7 @@ Notation left_pts := (left_pts R edge).
 Notation right_pts := (right_pts R edge).
 Notation dummy_pt := (dummy_pt R 1).
 Notation event := (@event R edge).
-Notation point := (@point R edge).
+Notation point' := (@point R edge).
 Notation outgoing := (@point R edge).
 
 Variables closed : seq cell.
@@ -630,6 +630,7 @@ move/hasP=> [e2 e2in /eqP ->].
 by apply: (@allP pt _ _ inbox_es); rewrite map_f.
 Qed.
 
+Notation event' := (generic_trajectories.event R edge).
 Lemma start_yields_safe_cells evs bottom top (open closed : seq cell):
   sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) evs ->
   {in [:: bottom, top &
@@ -643,6 +644,9 @@ Lemma start_yields_safe_cells evs bottom top (open closed : seq cell):
   {in closed & events_to_edges evs, forall c g p,
     strict_inside_closed p c -> ~~(p === g)}.
 Proof.
+set event' := generic_trajectories.event _ _.
+set p_x' := generic_trajectories.p_x R.
+set point' := generic_trajectories.point R edge.
 have [ev0 | evsn0] := eqVneq evs [::].
   rewrite /start /=; rewrite ev0 /=.
   by move=> _ _ _ _ _ _ _ [] _ <-.

From 3b91293244d217ef154c2bf9b3eeafb201d8c6b8 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Wed, 29 May 2024 16:27:06 +0200
Subject: [PATCH 40/43] last improvements before the talk

---
 documents/FHG_slides.tex | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/documents/FHG_slides.tex b/documents/FHG_slides.tex
index c345de6..d9394f2 100644
--- a/documents/FHG_slides.tex
+++ b/documents/FHG_slides.tex
@@ -44,7 +44,7 @@
 \item Decompose the space into simple cells
 \item Each cell is convex
 \item Each cell is free of obstacles
-\item Each cell may have neighbours where moving is safe
+\item Each cell may have safely reachable neighbors
 \end{itemize}
 \end{frame}
 \begin{frame}
@@ -52,7 +52,7 @@
 \includegraphics[trim={0 0 0 \topcrop}, clip, width=\textwidth]{cells_spiral.pdf}
 \end{frame}
 \begin{frame}
-\frametitle{Cell assumptions}
+\frametitle{Cell properties}
 \begin{itemize}
 \item Vertical edges are safe passages between two cells
 \item Moving directly from a left-edge to a right-edge is safe
@@ -79,6 +79,7 @@
 \item Easier to associate a distance between pairs of doors
 \item Dijkstra shortest path algorithm
 \end{itemize}
+\item In the end, a path from door to door
 \end{itemize}
 \end{frame}
 \begin{frame}
@@ -165,7 +166,6 @@
 \item Use of semi-closed vertical cells
 \item Show disjoint property
 \item Show that obstacles are covered by cell tops
-\item This proof is complete
 \end{itemize}
 \end{frame}
 \begin{frame}

From 57b7a677791e15bc63bbd750fde22d39b5ab4f62 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Mon, 21 Oct 2024 18:52:41 +0200
Subject: [PATCH 41/43] finished proving the common invariant for
 update_open_cell

---
 theories/cells.v                 |  11 +
 theories/cells_alg.v             | 518 ++++++++++++++++++++++++-------
 theories/math_comp_complements.v |  20 ++
 3 files changed, 441 insertions(+), 108 deletions(-)

diff --git a/theories/cells.v b/theories/cells.v
index 47d1bdd..a376596 100644
--- a/theories/cells.v
+++ b/theories/cells.v
@@ -107,11 +107,22 @@ Definition bottom_left_corner (c : cell) := last dummy_pt (left_pts c).
 Definition bottom_left_cells_lex (open : seq cell) p :=
   {in open, forall c, lexPt (bottom_left_corner c) p}.
 
+(* TODO: these should be at the head. *)
 Definition left_limit (c : cell) :=
   p_x (last dummy_pt (left_pts c)).
 
 Definition right_limit c := p_x (last dummy_pt (right_pts c)).
 
+Lemma add_point_left_limit (c : cell) (p : pt) :
+  (1 < size (left_pts c))%N ->
+  left_limit (set_left_pts _ _ c
+    (head dummy_pt (left_pts c) :: p :: behead (left_pts c))) =
+  left_limit c.
+Proof.
+rewrite /left_limit.
+by case lptsq : (left_pts c) => [ | p1 [ | p2 ps]].
+Qed.
+
 Definition inside_open_cell p c :=
   [&& contains_point p c & left_limit c <= p_x p <= open_limit c].
 
diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index 43c91f9..e91c01c 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -65,9 +65,13 @@ Notation left_pts := (left_pts R edge).
 Notation right_pts := (right_pts R edge).
 Notation Bcell := (Bcell R edge).
 
+(* TODO : these should probably be in cell.v *)
 Lemma high_set_left_pts (c : cell) l : high (set_left_pts c l) = high c.
 Proof. by case: c. Qed.
 
+Lemma low_set_left_pts (c : cell) l : low (set_left_pts c l) = low c.
+Proof. by case: c. Qed.
+
 Definition set_pts := set_pts R edge.
 
 (* This function is to be called only when the event is in the middle
@@ -75,7 +79,7 @@ Definition set_pts := set_pts R edge.
   points of one of the newly created open cells, but the one that receives
   the first segment of the last opening cells should keep its existing
   left points.*)
-Definition update_open_cell := 
+Definition update_open_cell :=
   update_open_cell R eq_op le +%R (fun x y => x - y) *%R (fun x y => x / y) 1
   edge (@unsafe_Bedge R) (@left_pt R) (@right_pt R).
 
@@ -125,7 +129,7 @@ Proof.
 case: s bottom => [ | c0 s] /= bottom; first by [].
 rewrite /cells_bottom_top /cells_low_e_top=> /= /andP[] /eqP lc0 A lowhigh.
 rewrite /cell_edges=> g; rewrite mem_cat.
-have main : [seq high c | c <- c0 :: s] = 
+have main : [seq high c | c <- c0 :: s] =
             rcons [seq low c | c <- s] (high (last c0 s)).
   elim: s c0 lowhigh {lc0 A} => [ | c1 s Ih] c0 lowhigh; first by [].
   rewrite /=.
@@ -251,7 +255,7 @@ repeat (split; first by []).
 by rewrite qeq !mem_cat !map_f ?orbT //; case:(cc1) => [| a b] /=; subset_tac.
 Qed.
 
-Lemma decomposition_connect_properties open_cells p 
+Lemma decomposition_connect_properties open_cells p
   first_cells contact last_contact last_cells low_f high_f:
 s_right_form open_cells ->
 seq_valid open_cells p ->
@@ -267,7 +271,7 @@ move=> rfo sval adj cbtom inbox_p oe.
 have [w win ctw'] := exists_cell cbtom adj inbox_p.
 have [ocd [ctpl [allct [allnct [nctlc [-> [-> _]]]]]]]:=
    decomposition_main_properties oe (exists_cell cbtom adj inbox_p).
-have [A B C D E] := 
+have [A B C D E] :=
   connect_properties cbtom adj rfo sval inbox_p ocd allnct allct ctpl nctlc.
 by split => // c cin; apply/negP/E.
 Qed.
@@ -831,8 +835,8 @@ Definition inv1_seq (s : seq cell) :=
 Definition invariant1 (s : scan_state) :=
   inv1_seq (state_open_seq s).
 
-Let val_between g (h : valid_edge g (point e)) := 
-  valid_between_events elexp plexfut h inbox_p.
+(* Let val_between g (h : valid_edge g (point e)) :=
+  valid_between_events elexp plexfut h inbox_p. *)
 
 #[clearbody]
 Let subo : {subset outgoing e <= all_edges open (e :: future_events)}.
@@ -985,7 +989,7 @@ have tls : high (last dummy_cell (rcons cc lcc)) =
           high (last dummy_cell (rcons nos nlsto)).
   by rewrite !last_rcons.
 split.
-  move: cbtom'; 
+  move: cbtom';
   rewrite (replacing_seq_cells_bottom_top _ _ _ _ on0 nn0) //.
   by rewrite -catA cat_rcons.
 rewrite -catA -cat_rcons.
@@ -1146,10 +1150,10 @@ Arguments pt_eqb : simpl never.
 Lemma step_keeps_invariant1 :
   invariant1 (step (Bscan fop lsto lop cls lstc lsthe lstx) e).
 Proof.
-case step_eq : (step _ _) => [fop' lsto' lop' cls' lstc' lsthe' lstx']. 
+case step_eq : (step _ _) => [fop' lsto' lop' cls' lstc' lsthe' lstx'].
 rewrite /state_open_seq /=; move: step_eq.
 rewrite /step/generic_trajectories.step -/open.
-have val_bet := valid_between_events elexp plexfut _ inbox_p.
+(* have val_bet := valid_between_events elexp plexfut _ inbox_p. *)
 case: ifP=> [pxaway | /negbFE/eqP/[dup] pxhere /abovelstle palstol].
   move: invariant1_default_case.
   rewrite -/(open_cells_decomposition _ _).
@@ -1322,7 +1326,7 @@ have claef' : close_alive_edges (fop ++ fc') future_events.
     - by apply/andP; apply: (allP svalf).
     by apply/negP; rewrite contains_pointE (negbTE (above_h _ cin)) andbF.
   apply/allP=> x; rewrite -f_eq => xin.
-  by apply: (allP (head_not_end claef f_not_end)).  
+  by apply: (allP (head_not_end claef f_not_end)).
 have clael : close_alive_edges lc (e :: future_events).
   by apply/allP=> x xin; apply: (allP clae); rewrite /open ocd; subset_tac.
 have clael' : close_alive_edges lc future_events.
@@ -1483,9 +1487,9 @@ Lemma new_edges_above_first_old fc cc lcc lc le:
   point e >>> le ->
   point e <<< high lcc ->
   valid_edge le (point e) ->
-  allrel (@edge_below _) 
+  allrel (@edge_below _)
     [seq high c | c <- fc]
-    [seq high c | c <- 
+    [seq high c | c <-
       opening_cells (point e) (outgoing e) le (high lcc)].
 Proof.
 move=> ocd.
@@ -1530,8 +1534,8 @@ Lemma new_edges_below_last_old fc cc lcc lc le:
   point e >>= le ->
   point e <<< high lcc ->
   valid_edge le (point e) ->
-  allrel (@edge_below _) 
-    [seq high c | c <- 
+  allrel (@edge_below _)
+    [seq high c | c <-
       opening_cells (point e) (outgoing e) le (high lcc)]
         [seq high c | c <- lc].
 Proof.
@@ -1564,10 +1568,10 @@ Qed.
 Lemma step_keeps_pw_default :
   let '(fc, cc, lcc, lc, le, he) :=
   open_cells_decomposition open (point e) in
-  let '(nos, lno) := 
+  let '(nos, lno) :=
     opening_cells_aux (point e)
         (sort (@edge_below _) (outgoing e)) le he in
-    pairwise (@edge_below _) 
+    pairwise (@edge_below _)
        (bottom :: [seq high x | x <- fc ++ nos ++ lno :: lc]).
 Proof.
 case oe: (open_cells_decomposition open (point e)) =>
@@ -1588,7 +1592,7 @@ rewrite /=; apply/andP; split.
   rewrite map_rcons all_rcons.
   have := opening_cells_aux_high_last vle vhe oute'; rewrite oca_eq /= => ->.
   have -> /= : bottom <| he.
-    have lcco : lcc \in open by rewrite ocd !mem_cat inE eqxx !orbT. 
+    have lcco : lcc \in open by rewrite ocd !mem_cat inE eqxx !orbT.
     rewrite heq.
     move: pwo=> /= /andP[] /allP /(_ (high lcc)) + _; rewrite map_f //.
     by apply.
@@ -2086,7 +2090,7 @@ split.
   have [/eqP c1c2 | c1nc2] := boolP(c1' == c2').
     by left; rewrite c1eq c2eq c1c2.
   right=> q; apply/negP=> /andP[inc1 inc2].
-  case: (disjoint_open c1'open c2'open)=> [/eqP | /(_ q)]. 
+  case: (disjoint_open c1'open c2'open)=> [/eqP | /(_ q)].
     by rewrite (negbTE c1nc2).
   move=> /negP[].
   rewrite c1eq in inc1; rewrite c2eq in inc2.
@@ -2132,7 +2136,7 @@ rewrite (cell_edges_sub_high cbtom adj) inE=> /orP[/eqP -> | /pwo' //].
 by apply: edge_below_refl.
 Qed.
 
-Definition state_closed_seq (s : scan_state) := 
+Definition state_closed_seq (s : scan_state) :=
   rcons (sc_closed s) (lst_closed s).
 
 Lemma adjacent_update_open_cell new_op new_lsto:
@@ -2245,11 +2249,11 @@ rewrite -/(opening_cells_aux _ _ _ _).
 by case oca_eq : (opening_cells_aux _ _ _ _) => [[ | ? ?] ?] + [] <- <- /=.
 Qed.
 
-Lemma update_open_cell_valid c nos lno :
+(* Lemma update_open_cell_valid c nos lno :
   valid_edge (low c) (point e) ->
   valid_edge (high c) (point e) ->
   update_open_cell c e = (nos, lno) ->
-  seq_valid (rcons nos lno) p = 
+  seq_valid (rcons nos lno) p =
   seq_valid (opening_cells (point e) (outgoing e) (low c) (high c)) p.
 Proof.
 move=> vlc vhc; rewrite /update_open_cell/generic_trajectories.update_open_cell.
@@ -2263,7 +2267,7 @@ have := opening_cells_aux_absurd_case vlc vhc onn oute; rewrite ogeq.
 rewrite -/(opening_cells_aux _ _ _ _).
 by case oca_eq : (opening_cells_aux _ _ _ _) => [[ | ? ?] ?] + [] <- <- /=.
 Qed.
-
+*)
 Lemma lex_left_pts_inf' :
   let '(fc, _, _, lc, le, he) :=
     open_cells_decomposition open (point e) in
@@ -2310,7 +2314,7 @@ Lemma step_keeps_btom_left_corners_default q :
     opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he in
     {in fc ++ nos ++ lno :: lc, forall c, lexPt  (bottom_left_corner c) q}.
 Proof.
-move=> lexq.  
+move=> lexq.
 case oe : (open_cells_decomposition _ _) => [[[[[fc cc] lcc] lc] le] he].
 case oca_eq: (opening_cells_aux _ _ _ _) => [nos lno].
 have := lex_left_pts_inf'; rewrite oe oca_eq => main.
@@ -2463,6 +2467,57 @@ rewrite /set_right_pts /=.
 by rewrite /set_right_pts /= => <- //.
 Qed.
 
+Definition update_pts_head (l : seq pt) (p : pt) :=
+  p :: behead l.
+
+Definition update_pts_single (l : seq pt) (p : pt) :=
+  head dummy_pt l :: p :: behead l.
+
+Lemma update_open_cell_outgoing_empty c (lo : seq cell * cell) :
+ valid_edge (low c) (point e) ->
+ valid_edge (high c) (point e) ->
+ open_cell_side_limit_ok c ->
+ p_x (point e) = left_limit c ->
+ (1 < size (left_pts c))%N ->
+ point e >>> low c ->
+ point e <<< high c ->
+outgoing e = [::] ->
+  update_open_cell c e =
+  ([::], set_left_pts
+    c (update_pts_single (left_pts c) (point e))).
+Proof.
+intros vl vh okc xq lptsgt pal puh ogq.
+by rewrite /update_open_cell/generic_trajectories.update_open_cell ogq.
+Qed.
+
+Lemma update_open_cell_tail c (lo : seq cell * cell) :
+ valid_edge (low c) (point e) ->
+ valid_edge (high c) (point e) ->
+ open_cell_side_limit_ok c ->
+ p_x (point e) = left_limit c ->
+ (1 < size (left_pts c))%N ->
+ point e >>> low c ->
+ point e <<< high c ->
+  outgoing e != [::] ->
+  behead (rcons (update_open_cell c e).1
+               (update_open_cell c e).2) =
+  behead (opening_cells (point e) (outgoing e) (low c) (high c)).
+Proof.
+move=> vl vh cok at_x lgt1 pal puh on0.
+rewrite /update_open_cell/generic_trajectories.update_open_cell.
+case ogq : (outgoing e) => [ | fog ogs]; first by rewrite ogq in on0.
+case oca_eq : generic_trajectories.opening_cells_aux => [nos lno].
+have son0 : (fog :: ogs) != [::] by [].
+have oute2 : {in fog :: ogs,
+      forall g, left_pt g == point e}.
+  by rewrite -ogq.
+have := opening_cells_aux_absurd_case vl vh son0 oute2.
+rewrite /opening_cells_aux oca_eq /=.
+case nosq : nos => [ | fno nos']; first by [].
+move=> _ /=.
+by rewrite /opening_cells/opening_cells_aux oca_eq nosq.
+Qed.
+
 Lemma update_open_cellE1 c c1 :
  valid_edge (low c) (point e) ->
  valid_edge (high c) (point e) ->
@@ -2472,7 +2527,7 @@ Lemma update_open_cellE1 c c1 :
  point e >>> low c ->
  point e <<< high c ->
  c1 \in (update_open_cell c e).1 ->
- exists2 c', c' \in (opening_cells_aux (point e) 
+ exists2 c', c' \in (opening_cells_aux (point e)
                         (sort (@edge_below _) (outgoing e)) (low c)
     (high c)).1 &
      c1 = c' \/
@@ -2624,8 +2679,8 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
     have lstcin : lstc \in rcons cls lstc by rewrite mem_rcons inE eqxx.
     have in' c : c \in cls -> c \in rcons cls lstc.
       by move=> cin; rewrite mem_rcons inE cin orbT.
-    have main c1 q: 
-         c_disjoint c1 lstc -> 
+    have main c1 q:
+         c_disjoint c1 lstc ->
          c_disjoint c1 (update_closed_cell lstc q).
       by move=> /[swap] q1 /(_ q1); rewrite -inside_closed'_update.
     move=> c1 c2; rewrite !mem_rcons !inE !(orbC _ (_ \in cls)).
@@ -2636,7 +2691,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
     apply: c_disjoint_eC; right; apply: main.
     case: (disjoint_closed (in' _ c2in) lstcin)=> //.
     by move: lstcn=> /[swap] <-; rewrite c2in.
-  have main c : 
+  have main c :
      oc_disjoint c lstc ->
      oc_disjoint c (update_closed_cell lstc (point e)).
     by rewrite /oc_disjoint=> /[swap] q /(_ q); rewrite -inside_closed'_update.
@@ -2651,7 +2706,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
   rewrite uoc_eq /=.
   have := update_open_cellE2 vlo vho lstok pxo slpts palstol puh.
   rewrite uoc_eq /=.
-  rewrite oe.  
+  rewrite oe.
   case oca_eq : (opening_cells_aux _ _ _ _) => [nos' lno'] /= helper2 helper1.
   move=> [] _ helper3.
   move=> c1 c2 c1in; rewrite mem_rcons inE => /orP[/eqP -> | ].
@@ -2670,7 +2725,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
     rewrite inE=> /orP[/eqP -> | ].
       case: helper2=> [ -> | -> ].
         by apply: helper3; rewrite !mem_cat ?mem_rcons !inE !eqxx ?orbT.
-      set W := (set_left_pts _ _).    
+      set W := (set_left_pts _ _).
       move=> q.
       suff -> : inside_open' q W = inside_open' q lsto.
         by apply: disjoint_open_closed;
@@ -2686,7 +2741,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
     by apply: disjoint_open_closed;
        rewrite ?mem_cat ?mem_rcons ?inE ?c1f ?eqxx ?c2in ?orbT.
   move=> /orP[/helper1 [c1' c1no'] |].
-    move=> [-> | [l lq -> q] ].  
+    move=> [-> | [l lq -> q] ].
       by apply: helper3; rewrite !(mem_rcons, mem_cat, inE) ?c1no' ?c2in ?orbT.
     suff -> : inside_open' q (set_left_pts c1' l) = inside_open' q c1'.
       by apply: helper3;
@@ -2695,7 +2750,7 @@ case: ifP => [ebelow_st {ebelow} | eonlsthe].
   rewrite inE=> /orP[/eqP -> | ].
     move: helper2=> [-> | ->].
       by apply: helper3; rewrite !(mem_cat, mem_rcons, inE) ?eqxx ?c2in ?orbT.
-    set W := (set_left_pts _ _).    
+    set W := (set_left_pts _ _).
     move=> q.
     suff -> : inside_open' q W = inside_open' q lsto.
       by apply: disjoint_open_closed;
@@ -2739,7 +2794,7 @@ case ogq : (outgoing e) => [ | fog og]; last first.
   rewrite /state_open_seq /state_closed_seq /=.
   have := step_keeps_disjoint_default'; rewrite oe' ogq lelow oca_eq /=.
   move=> [] clsdisj ocdisj.
-  split.           
+  split.
     move=> x y xin yin; apply: clsdisj.
       move: xin; rewrite !(mem_rcons, inE, mem_cat).
       move=>/orP[-> | /orP[ | /orP[ ->| ->]]]; rewrite ?orbT //.
@@ -2851,6 +2906,19 @@ apply/eqP; apply: same_pvert_y; first by case/andP: one.
 by rewrite pxhere sx.
 Qed.
 
+Lemma opening_cells_subset' p' (le he : edge) (s sup : seq edge) :
+  le \in sup -> he \in sup -> {subset s <= sup} ->
+  valid_edge le p' -> valid_edge he p' ->
+  {in s, forall g, left_pt g == p'} ->
+  {subset cell_edges (opening_cells p' s le he) <= sup}.
+Proof.
+move=> lein hein ssub vl vh outp' /= g.
+have ocs := opening_cells_subset vl vh outp'.
+rewrite mem_cat=> /orP[] /mapP [/= c /[swap] + /ocs +] => <-.
+  by move=> /andP[] + _; rewrite inE=> /orP[/eqP -> // | ]; apply: ssub.
+by move=> /andP[] _; rewrite inE=> /orP[/eqP -> // | ]; apply: ssub.
+Qed.
+
 Lemma step_keeps_injective_high_default :
   let '(fc, cc, lcc, lc, le, he) :=
     open_cells_decomposition open (point e) in
@@ -2940,7 +3008,7 @@ rewrite /= => /andP[].
 case: ifP => [/eqP -> | _ _ /Ih -> //].
 by rewrite mem_cat inE eqxx orbT.
 Qed.
-  
+
 Lemma index_map_in (T1 T2 : eqType) (f : T1 -> T2) (s : seq T1) :
   {in s &, injective f} ->
   {in s, forall x, index (f x) [seq f i | i <- s] = index x s}.
@@ -3002,7 +3070,7 @@ have : nth (high dummy_cell) [seq high c | c <- l2'] j1 = high x1.
   by rewrite (nth_map dummy_cell) // j1q.
 have : nth (high dummy_cell) [seq high c | c <- l2'] j2 = high x1.
   by rewrite hx1x2 (nth_map dummy_cell) // j2q.
-move=> <-; rewrite -eqh. 
+move=> <-; rewrite -eqh.
 move: uh=> /uniqP => /(_ dummy_edge); rewrite [X in size X]eqh size_map.
 move=> /(_ j1 j2); rewrite !inE => /(_ j1lt j2lt) /[apply].
 by rewrite -j1q -j2q => ->.
@@ -3010,7 +3078,7 @@ Qed.
 
 Lemma step_keeps_uniq_default fc cc lcc lc le he nos lno:
   open_cells_decomposition open (point e) = (fc, cc, lcc, lc, le, he) ->
-  opening_cells_aux (point e) 
+  opening_cells_aux (point e)
       (sort (@edge_below _) (outgoing e)) le he = (nos, lno) ->
   uniq (fc ++ nos ++ lno :: lc).
 Proof.
@@ -3504,7 +3572,7 @@ Lemma opening_cells_aux_cover_outgoing le he nos lno:
   valid_edge le (point e) ->
   opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he =
   (nos, lno) ->
-  {in (outgoing e), forall g, 
+  {in (outgoing e), forall g,
   exists c, c \in nos /\ high c = g /\ left_limit c = p_x (left_pt g)}.
 Proof.
 move=> + + g go.
@@ -3559,8 +3627,8 @@ move=> g [go | gn]; last first.
   split; first by [].
   split; last by [].
   by rewrite !mem_cat cin !orbT.
-case: go => [[opc [pcc [pccsub opcP]]] | 
-              [ pcc [pccn0 [pccsub pccP]]]]; last first.  
+case: go => [[opc [pcc [pccsub opcP]]] |
+              [ pcc [pccn0 [pccsub pccP]]]]; last first.
   right; exists pcc.
  split;[exact pccn0 | split; [ | exact pccP]].
   by move=> g1 /pccsub; rewrite mem_cat=> ->.
@@ -3691,7 +3759,7 @@ rewrite !mem_cat !inE=> /orP[ -> | /orP [ | -> ]]; rewrite ?orbT //.
 by move: cnopc=> /[swap]; rewrite eq_sym=> ->.
 Qed.
 
-Lemma update_closed_cell_keep_left_limit c pt : 
+Lemma update_closed_cell_keep_left_limit c pt :
   left_limit (update_closed_cell c pt) = left_limit c.
 Proof. by move: c => [? ? ? ?]. Qed.
 
@@ -3703,7 +3771,7 @@ move=> ll rr; elim: l => [ | a [ | b l] Ih] /=; first by [].
   by case: ifP.
 move=> /[dup] conn /andP[ab conn'].
 have conn0 : path (fun c1 c2 => right_limit c1 == left_limit c2) a (b :: l).
-   by exact: conn. 
+   by exact: conn.
 have /Ih : sorted (fun c1 c2 => right_limit c1 == left_limit c2) (b :: l).
   by apply: (path_sorted conn0).
 case: ifP=> [/eqP ac | anc].
@@ -3750,7 +3818,7 @@ case: ecg => [[oc [pcc [ocP1 [hP [cP [ocin conn]]]]]] | ].
     rewrite /=; case: ifP=> [ac | anc].
       rewrite inE=> /orP[/eqP -> | ]; last by [].
       have: high c = g by apply: hP; rewrite inE eq_sym ac.
-      by case: (c).    
+      by case: (c).
     rewrite inE=> /orP[/eqP -> | ]; last by [].
     by apply: hP; rewrite inE eqxx.
   split.
@@ -4047,7 +4115,7 @@ rewrite ccq inE -orbA => /orP[/eqP oclsto | ].
   right; exists pcc.
     split.
       by rewrite pccq.
-    split.    
+    split.
       move=> x /P1; rewrite !(mem_rcons, mem_cat, inE).
       by move=> /orP[] -> ; rewrite ?orbT.
     split.
@@ -4086,7 +4154,7 @@ rewrite ccq inE -orbA => /orP[/eqP oclsto | ].
     rewrite -ogq.
     rewrite -/(opening_cells_aux _ _ _ _).
     case oca_eq: opening_cells_aux => [ [ | fno nos'] lno'] [] _ <-;
-      have := opening_cells_left oute vlo vhe; 
+      have := opening_cells_left oute vlo vhe;
       rewrite /opening_cells oca_eq=> /(_ lno');
       by rewrite mem_rcons inE eqxx=> /(_ isT).
   have vlcc : valid_cell lcc (point e).
@@ -4110,7 +4178,7 @@ rewrite ccq inE -orbA => /orP[/eqP oclsto | ].
     move: P3; rewrite pccq connect_limits_rcons // => /andP[] -> /=.
     move=> /eqP ->; rewrite /left_limit (eqP oclcc).
     by have [_ _ ->] := close_cell_preserve_3sides (point e) lcc.
-  split; first by rewrite !mem_cat inE eqxx !orbT.    
+  split; first by rewrite !mem_cat inE eqxx !orbT.
   rewrite /head_cell !head_rcons.
   move: P5; rewrite (eqP oclcc) => <-.
   case: (pcc) => [ /= | ? ?]; last by [].
@@ -4180,7 +4248,7 @@ rewrite map_rcons=> -> g'; rewrite !mem_rcons !inE mem_sort; congr (_ || _).
 by have := opening_cells_aux_high_last vl vp oute'; rewrite oca_eq /= => ->.
 Qed.
 
-Lemma step_keeps_subset : 
+Lemma step_keeps_subset :
   let s' :=  step (Bscan fop lsto lop cls lstc lsthe lstx) e in
   {subset [seq high c | c <- state_open_seq s'] <=
     [seq high c | c <- open] ++ outgoing e}.
@@ -4294,10 +4362,10 @@ Lemma step_keeps_left_limit_has_right_limit_default :
     open_cells_decomposition open (point e) in
     let '(nos, lno) := opening_cells_aux (point e)
        (sort (@edge_below _) (outgoing e)) le he in
-  {in fc ++ nos ++ lno :: lc, 
+  {in fc ++ nos ++ lno :: lc,
    forall c p, inside_box p -> left_limit c = p_x p ->
      contains_point' p c ->
-     has (inside_closed' p) 
+     has (inside_closed' p)
       (cls ++ lstc :: rcons (closing_cells (point e) cc)
          (close_cell (point e) lcc))}.
 Proof.
@@ -4313,7 +4381,7 @@ remember (fc ++ nos ++ lno :: lc) as open' eqn:openeq.
 remember (cls ++ lstc :: rcons (closing_cells (point e) cc)
            (close_cell (point e) lcc)) as closed' eqn:closeeq.
 have := invariant1_default_case.
-  rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'. 
+  rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'.
 move=> c cin pt' inboxp lbnd pin.
 move: cin; rewrite openeq -cat_rcons !mem_cat orbCA orbC=> /orP[cold | cnew].
   rewrite closeeq -cat_rcons has_cat; apply/orP; left.
@@ -4340,7 +4408,7 @@ have highnew : [seq high i | i <- opening_cells (point e)(outgoing e) le he]=
                rcons (sort (@edge_below _) (outgoing e)) he.
   by rewrite (opening_cells_high vl vp).
 have allval : all (fun g => valid_edge g pt')
-     (head dummy_edge [seq low i | i <- opening_cells (point e) 
+     (head dummy_edge [seq low i | i <- opening_cells (point e)
               (outgoing e) le he] ::
      [seq high i | i <- opening_cells (point e) (outgoing e) le he]).
   apply/allP=> x; rewrite inE=> xin.
@@ -4522,7 +4590,7 @@ remember (fc ++ nos ++ lno :: lc) as open' eqn:openeq.
 remember (cls ++ lstc :: rcons (closing_cells (point e) cc)
            (close_cell (point e) lcc)) as closed' eqn:closeeq.
 have := invariant1_default_case.
-rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'. 
+rewrite oe oca_eq => - [] clae' [] sval' [] adj' []cbtom' rfo'.
 have := step_keeps_left_limit_has_right_limit_default.
 have := step_keeps_btom_left_corners_default.
 rewrite oe oca_eq -openeq.
@@ -4686,7 +4754,7 @@ move=> /orP[/hasP[opc opcin qinopc] | keptopen].
     apply/orP; right; apply/hasP.
     by exists it=> //; rewrite closeeq !(inE, mem_cat, mem_rcons) it1 ?orbT.
   apply/orP; right; apply/hasP; exists (close_cell (point e) lcc).
-    by rewrite closeeq !(mem_cat, inE, mem_rcons) eqxx ?orbT. 
+    by rewrite closeeq !(mem_cat, inE, mem_rcons) eqxx ?orbT.
   by apply: inclosel; rewrite -(eqP opclcc).
 apply/orP; left; apply/hasP.
 move: keptopen; rewrite -has_cat=>/hasP[it + it2].
@@ -4698,7 +4766,7 @@ Lemma step_keeps_right_limit_closed_default :
     open_cells_decomposition open (point e) in
     let '(nos, lno) := opening_cells_aux (point e)
        (sort (@edge_below _) (outgoing e)) le he in
-  {in  rcons(cls ++ 
+  {in  rcons(cls ++
           lstc :: closing_cells (point e) cc) (close_cell (point e) lcc) &
      future_events, forall c e, right_limit c <= p_x (point e)}.
 Proof.
@@ -4968,14 +5036,14 @@ have [pal puh vle vhe nc]:=
       (inside_box_between inbox_e) oe.
 have [ogq | ogq] := eqVneq (outgoing e) [::].
   rewrite (single_opening_cell_side_char pp vle vhe pal puh ogq).
-  case ccq : cc => [ | cc1 cc'].  
+  case ccq : cc => [ | cc1 cc'].
     move: (oe); rewrite ccq=> oe'.
     by rewrite /= (single_closing_side_char pp oe') orbF.
   move: (oe); rewrite ccq=> oe'.
   rewrite /= has_rcons.
   rewrite (first_closing_side_char pp oe').
   rewrite (negbTE (middle_closing_side_char _ oe')) orbF.
-  rewrite (last_closing_side_char pp oe'); last by []. 
+  rewrite (last_closing_side_char pp oe'); last by [].
   by rewrite (andbC (pp >>> le)) (andbC (pp <<< he)).
 rewrite /opening_cells; case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
 have oeq : opening_cells (point e) (outgoing e) le he = rcons nos lno.
@@ -4988,15 +5056,15 @@ rewrite (first_opening_cells_side_char pp ogq vle vhe pal oute oeq).
 rewrite [in X in _ == X]has_rcons.
 rewrite (last_opening_cells_side_char pp ogq vle vhe puh oute oeq).
 rewrite (negbTE (middle_opening_cells_side_char pp ogq vle vhe oute oeq)) orbF.
-case ccq : cc => [ | cc1 cc'].  
+case ccq : cc => [ | cc1 cc'].
     move: (oe); rewrite ccq=> oe'.
     rewrite /= (single_closing_side_char pp oe') orbF.
     by rewrite (andbC (_ >>> _)) (andbC (_ <<< _)).
 move: (oe); rewrite ccq=> oe'.
-rewrite /= has_rcons.  
+rewrite /= has_rcons.
 rewrite (first_closing_side_char pp oe').
 rewrite (negbTE (middle_closing_side_char _ oe')) orbF.
-by rewrite (last_closing_side_char pp oe'); last by []. 
+by rewrite (last_closing_side_char pp oe'); last by [].
 Qed.
 
 End step.
@@ -5044,7 +5112,7 @@ Record common_general_position_invariant bottom top edge_set s
 
 Record common_non_gp_invariant bottom top edge_set s (events : seq event') :=
   { ngcomm : common_invariant bottom top edge_set s events;
-    lst_side_lex : 
+    lst_side_lex :
         (1 < size (left_pts (lst_open s)))%N &&
         path (@lexPt _) (nth dummy_pt (left_pts (lst_open s)) 1)
          [seq point e | e <- events]}.
@@ -5188,7 +5256,7 @@ have :=
   initial_intermediate boxwf startok nocs' evin lexev evsub out_evs cle evsn0.
 case evsq : events evsn0 => [ | ev future_events]; [by [] | move=> _].
 move=> [op0sok [cbtom0 [adj0 /=
-           [sval0 [rf0 [inbox0 [cle0 [oute0 [clae0 [vb 
+           [sval0 [rf0 [inbox0 [cle0 [oute0 [clae0 [vb
              [vt [oe [nocs [noc0 [pw0 lexev0]]]]]]]]]]]]]]].
 have evins : ev \in events by rewrite evsq inE eqxx.
 set op0 := start_open_cell bottom top.
@@ -5295,7 +5363,7 @@ move=> vle vhe; elim: gs le vle nos lno=>
     case: ifP=> [/eqP abs2 | dif2 //]; last first.
       by move=> [] _ <- /=.
     by move=> [] _ <- /=; split; [ | rewrite -abs2].
-  move=> [] _.    
+  move=> [] _.
   rewrite (strict_under_pvert_y vhe) ltNge in puh.
   move: puh => /negP; case.
   by rewrite on_pvert // -abs1 pvert_on.
@@ -5389,7 +5457,7 @@ have := initial_intermediate boxwf startok nocs' evin lexev evsub
    out_evs cle evsn0.
 move: evsn0; case evsq : events => [ | ev evs];[by [] | move=> _].
 lazy zeta; rewrite [head _ _]/= [behead _]/=.
-move=> -[] op0sok [cbtom0 [adj0 [sval0 [rf0 [inbox0 
+move=> -[] op0sok [cbtom0 [adj0 [sval0 [rf0 [inbox0
 [cle0 [oute0 [clae0 [vb [vt [oe [nocs [noc0 [pw0 lexev0]]]]]]]]]]]]]].
 have evins : ev \in events by rewrite evsq inE eqxx.
 rewrite /initial_state /state_open_seq/state_closed_seq/= => Cinv.
@@ -5414,7 +5482,7 @@ have pw1 : pairwise (@edge_below _)
   by rewrite oe oca_eq.
 have rl_closed1 : {in [:: close_cell (point ev) op0] & evs,
   forall c e, right_limit c <= p_x (point e)}.
-  have vho : valid_edge (high op0) (point ev) by []. 
+  have vho : valid_edge (high op0) (point ev) by [].
   have vlo : valid_edge (low op0) (point ev) by [].
   have := right_limit_close_cell vlo vho=> rlcl0 c e.
   rewrite inE=> /eqP ->.
@@ -5425,7 +5493,7 @@ have rl_closed1 : {in [:: close_cell (point ev) op0] & evs,
 by constructor.
 Qed.
 
-Lemma simple_step_common_general_position_invariant
+Lemma simple_step_common_invariant
   bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
   lsthe lstx evs :
   bottom <| top ->
@@ -5434,18 +5502,18 @@ Lemma simple_step_common_general_position_invariant
                    inside_box bottom top (right_pt g)} ->
   open_cells_decomposition (fop ++ lsto :: lop) (point ev) =
     (fc, cc, lcc, lc, le, he) ->
-  common_general_position_invariant bottom top s
+  common_invariant bottom top s
      (Bscan fop lsto lop cls lstc lsthe lstx)
      (ev :: evs) ->
-  common_general_position_invariant bottom top s
+  common_invariant bottom top s
      (simple_step fc cc lc lcc le he cls lstc ev)
     evs.
 Proof.
 move=> boxwf nocs' inbox_s oe.
-move=> [] []; rewrite /state_open_seq/state_closed_seq/=.
-move=> inv lstxq lstheq sub_edges cle  out_es /[dup] inbox0.
+move=> []; rewrite /state_open_seq/state_closed_seq/=.
+move=> inv lstxq lstheq sub_edges cle out_es /[dup] inbox0.
 move=> /andP[] inbox_e inbox_es.
-move=> lexev oks /andP[] lstxlt ltev'.
+move=> lexev oks.
 move: (inv)=> [] clae [] []; first by [].
 move=> sval [] adj [] cbtom rfo.
 have oute : out_left_event ev.
@@ -5475,7 +5543,7 @@ have [{}pal {}puh vl vp nc]:=
 have /esym left_last : left_limit lno = p_x (point ev).
   apply: (opening_cells_left oute vl vp).
   by rewrite /opening_cells oca_eq mem_rcons inE eqxx.
-have heqo : high lno = he. 
+have heqo : high lno = he.
   by have := opening_cells_aux_high_last vl vp oute'; rewrite oca_eq.
 have sub_edges' : {subset all_edges ((fc ++ nos) ++ lno :: lc) evs <=
                      [:: bottom, top & s]}.
@@ -5485,7 +5553,7 @@ have sub_edges' : {subset all_edges ((fc ++ nos) ++ lno :: lc) evs <=
     apply: sub_edges; rewrite mem_cat; apply/orP; right.
     by rewrite events_to_edges_cons mem_cat gin orbT.
   rewrite (cell_edges_sub_high cbtom' adj') inE=> /orP[/eqP -> | /main].
-    by rewrite inE eqxx.  
+    by rewrite inE eqxx.
   rewrite mem_cat=> /orP[] gin; apply: sub_edges; last first.
     by rewrite mem_cat events_to_edges_cons orbC mem_cat gin.
   by rewrite mem_cat mem_cat gin orbT.
@@ -5497,13 +5565,247 @@ have oks' : all open_cell_side_limit_ok ((fc ++ nos) ++ lno :: lc).
   have := step_keeps_open_side_limit_default inbox0 oute rfo
     cbtom adj sval oks; rewrite oe oca_eq.
   by [].
-have ltev1 : all (fun e => p_x (point ev) < p_x (point e)) evs &&
+by constructor.
+Qed.
+
+Lemma simple_step_common_general_position_invariant
+  bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  open_cells_decomposition (fop ++ lsto :: lop) (point ev) =
+    (fc, cc, lcc, lc, le, he) ->
+  common_general_position_invariant bottom top s
+     (Bscan fop lsto lop cls lstc lsthe lstx)
+     (ev :: evs) ->
+  common_general_position_invariant bottom top s
+     (simple_step fc cc lc lcc le he cls lstc ev)
+    evs.
+Proof.
+move=> boxwf nocs' inbox_s oe.
+move=> [] comi /andP[] lstxlt ltev'.
+have comi' := (simple_step_common_invariant boxwf nocs' inbox_s oe comi).
+have ltev1 : all (fun e =>
+            lst_x _ _ (simple_step fc cc lc lcc le he cls lstc ev) <
+               p_x (point e)) evs &&
          sorted (fun e1 e2 => p_x (point e1) < p_x (point e2)) evs.
-  move: ltev'; rewrite path_sortedE //.
+  rewrite (lstx_eq comi').
+  have oute : out_left_event ev by apply: (out_events comi); rewrite inE eqxx.
+  have [_ [sval' [adj [cbtom rfo]]]] := inv1 comi.
+  have /= /andP[inbox_e inbox_es] := inbox_events comi.
+  have sval : seq_valid
+          (state_open_seq (Bscan fop lsto lop cls lstc lsthe lstx))
+          (point ev).
+    by case sval'; first done.
+  have [{}pal {}puh vl vp nc]:=
+    decomposition_connect_properties rfo sval adj cbtom
+    (inside_box_between inbox_e) oe.
+  have := opening_cells_left oute vl vp.
+  rewrite /opening_cells/simple_step/generic_trajectories.simple_step.
+  rewrite -/(opening_cells_aux (point ev) (sort (@edge_below _) (outgoing ev))
+               le he).
+  case oca_eq : opening_cells_aux => [nos lno] /=.
+  have lnoin : lno \in rcons nos lno by rewrite mem_rcons inE eqxx.
+  move => /(_ _ lnoin) ->.
+  move: ltev'; rewrite /= path_sortedE //.
   by move=> x y z; apply: lt_trans.
 by constructor.
 Qed.
 
+Lemma update_open_cell_common_invariant
+  bottom top s fop lsto lop cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  lstx = p_x (point ev) ->
+  (point ev) <<< lsthe ->
+  common_non_gp_invariant bottom top s
+     (Bscan fop lsto lop cls lstc lsthe lstx)
+     (ev :: evs) ->
+  common_invariant bottom top s
+     (step (Bscan fop lsto lop cls lstc lsthe lstx) ev)
+    evs.
+Proof.
+move=> bxwf nocs' inbox_s at_lstx under_lsthe comng.
+have comi := ngcomm comng.
+rewrite /step/generic_trajectories.step.
+rewrite /same_x at_lstx eqxx /=.
+rewrite -/(point_under_edge _ _) underW /=; last by [].
+rewrite -/(point ev <<< lsthe) under_lsthe.
+have oute : out_left_event ev.
+  by apply: (out_events comi); rewrite inE eqxx.
+have oute' : {in sort (@edge_below _) (outgoing ev),
+                  forall g, left_pt g == point ev}.
+  by move=> g; rewrite mem_sort; apply: oute.
+have [clae [sval' [adj [cbtom rfo]]]] := inv1 comi.
+have sval : seq_valid (state_open_seq (Bscan fop lsto lop cls lstc lsthe lstx))
+              (point ev).
+  by case: sval'.
+have lstx_ll : lstx = left_limit lsto.
+  rewrite -[lstx]/(lst_x _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
+  by rewrite (lstx_eq comi).
+have pal : (point ev) >>> low lsto.
+  have := lst_side_lex comng.
+  set W := (X in size X); rewrite -/W.
+  have : open_cell_side_limit_ok lsto.
+    by apply: (allP (sides_ok comi)); rewrite mem_cat inE eqxx orbT.
+  rewrite /open_cell_side_limit_ok => /andP[] _ /andP[] + /andP[] + /andP[].
+  move=> + + _ +.
+  rewrite -/W.
+  case wq : W => [ | p1 [ | p2 ps]] //= A /andP[] _ higherps + /andP[] ll _.
+  move: A => /andP[] _ /andP[] p2x allx.
+  have lx : p_x (last p2 ps) == left_limit lsto.
+    case : (ps) allx => [ | p3 pst] // /allP; apply=> /=.
+    by rewrite mem_last.
+  have samex : p_x (point ev) = p_x (last p2 ps).
+    by rewrite -at_lstx lstx_ll (eqP lx).
+  have cmpy : p_y (last p2 ps) <= p_y p2.
+    case psq : ps => [ | p3 pst] //.
+    apply ltW.
+    rewrite (path_sortedE (rev_trans lt_trans)) psq in higherps.
+    move: higherps=> /andP[] /allP /(_ (p_y (last p3 pst))) + _.
+    rewrite map_f; last by rewrite mem_last.
+    by move=> /(_ isT).
+  move=> /(under_edge_lower_y samex) ->.
+  rewrite -ltNge.
+  apply: (le_lt_trans cmpy).
+  move: ll; rewrite /lexPt.
+  by rewrite lt_neqAle samex (eqP p2x) eq_sym lx /=.
+have abovelow : p_x (point ev) = lstx -> (point ev) >>> low lsto by [].
+have noc : {in all_edges (fop ++ lsto :: lop) (ev :: evs) &,
+           no_crossing R}.
+  apply: inter_at_ext_no_crossing.
+  by apply: (sub_in2 (edges_sub comi) nocs').
+have lstoin : lsto \in (fop ++ lsto :: lop).
+  by rewrite mem_cat inE eqxx orbT.
+have sok : open_cell_side_limit_ok lsto.
+  by apply: (allP (sides_ok comi)); exact: lstoin.
+have xev_llo : p_x (point ev) = left_limit lsto.
+  by rewrite -at_lstx -(lstx_eq comi).
+have puho : point ev <<< high lsto.
+  move: under_lsthe.
+  rewrite -[lsthe]/(lst_high _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
+  by rewrite -(high_lsto_eq comi).
+have [vl vh] := (andP (allP sval lsto lstoin)).
+have sll : (1 < size (left_pts lsto))%N.
+  by apply: (size_left_lsto sval lstx_ll (sides_ok comi) (esym at_lstx) pal
+             (underW puho)).
+have ogsub : {subset (outgoing ev) <= [:: bottom, top & s]}.
+  move=> g gin; apply: (edges_sub comi); rewrite /all_edges mem_cat.
+  by apply/orP; right; rewrite events_to_edges_cons mem_cat gin.
+constructor.
+- have := step_keeps_invariant1 cls lstc (inbox_events comi) oute rfo cbtom adj
+          sval
+          (closed_events comi) clae (esym (high_lsto_eq comi)) abovelow noc
+          (lex_events comi).
+  rewrite /step /generic_trajectories.step/same_x -at_lstx eqxx /=.
+  rewrite -/(point_under_edge _ _) underW /=; last by [].
+  by rewrite -/(point ev <<< lsthe) under_lsthe.
+- rewrite -/(update_open_cell lsto ev).
+case uoc_eq : update_open_cell => [nos lno] /=.
+  have [case1 | case2]:= update_open_cellE2 oute vl vh sok xev_llo sll pal puho.
+    apply/esym.
+    have := opening_cells_left oute vl vh.
+    rewrite /opening_cells; move: case1; case: opening_cells_aux=> [nos' lno'].
+    rewrite uoc_eq /= => <- /(_ lno).
+    by apply; rewrite mem_rcons inE eqxx.
+  move: case2; rewrite uoc_eq /= => ->.
+  by rewrite (add_point_left_limit _ sll).
+- rewrite -/(update_open_cell lsto ev).
+  case uoc_eq : update_open_cell => [nos lno] /=.
+  have [case1 | case2]:= update_open_cellE2 oute vl vh sok xev_llo sll pal puho.
+    rewrite uoc_eq /= in case1; rewrite case1.
+    have := opening_cells_aux_high_last vl vh oute'.
+    case: opening_cells_aux => [lno' nos'] /= => ->.
+    by apply: (high_lsto_eq comi).
+  rewrite uoc_eq /= in case2; rewrite case2.
+  rewrite high_set_left_pts.
+  by apply: (high_lsto_eq comi).
+have llin : low lsto \in [:: bottom, top & s].
+  apply: (edges_sub comi); rewrite /all_edges mem_cat /state_open_seq /=.
+  by rewrite cell_edges_cat mem_cat cell_edges_cons inE eqxx !orbT.
+have hlin : high lsto \in [:: bottom, top & s].
+  apply: (edges_sub comi); rewrite /all_edges mem_cat /state_open_seq /=.
+  by rewrite cell_edges_cat mem_cat cell_edges_cons !inE eqxx !orbT.
+- rewrite -/(update_open_cell lsto ev).
+  case uoc_eq : update_open_cell => [nos lno].
+  rewrite /all_edges /state_open_seq /=.
+  apply: subset_catl; last first.
+    move=> g gin; apply: (edges_sub comi); rewrite /all_edges.
+    by rewrite mem_cat orbC events_to_edges_cons mem_cat gin orbT.
+  move=> g; rewrite cell_edges_cat mem_cat cell_edges_cons 2!inE.
+  rewrite cell_edges_cat mem_cat -!orbA=> /orP[gin | ] .
+    apply: (edges_sub comi); rewrite /state_open_seq /= /all_edges mem_cat.
+    by rewrite cell_edges_cat mem_cat gin.
+  move=> /orP[gin | ].
+  have [c cin gq] : exists2 c, c \in nos & g = high c \/ g = low c.
+    move: gin; rewrite mem_cat=> /orP[] /mapP[c cin gq]; exists c=> //.
+      by right.
+    by left.
+  have := update_open_cellE1 oute vl vh sok xev_llo sll pal puho.
+  rewrite uoc_eq /= => /(_ _ cin) [c' c'in Pc].
+  have /andP [lc'in hc'in] : (low c' \in [:: bottom, top & s]) &&
+           (high c' \in [:: bottom, top & s]).
+    have := opening_cells_subset' llin hlin ogsub vl vh oute.
+    rewrite /opening_cells.
+    move: c'in; case : opening_cells_aux => [nos' lno'] /= c'in main.
+    by rewrite !main // mem_cat map_f ?orbT // mem_rcons inE c'in ?orbT.
+  move: Pc gq=> [-> | [l lv ->]].
+    by move=> [] ->.
+  rewrite high_set_left_pts low_set_left_pts.
+  by move=> [] ->.
+- rewrite orbA=> /orP[ | gin]; last first.
+    apply: (edges_sub comi); rewrite /all_edges mem_cat /state_open_seq /=.
+    by rewrite cell_edges_cat mem_cat cell_edges_cons !inE gin !orbT.
+  have := update_open_cellE2 oute vl vh sok xev_llo sll pal puho.
+  rewrite uoc_eq /=.
+  have := opening_cells_subset' llin hlin ogsub vl vh oute.
+  rewrite /opening_cells.
+  move: opening_cells_aux => [nos' lno'] /= main.
+  move=> [] -> /orP gin.
+    apply: main; rewrite mem_cat; move: gin.
+    by move=> [] /eqP ->; rewrite map_f ?orbT //; rewrite mem_rcons inE eqxx.
+  move: gin; rewrite low_set_left_pts high_set_left_pts=> gin.
+  apply: (edges_sub comi); rewrite /all_edges/state_open_seq /=.
+  rewrite mem_cat cell_edges_cat mem_cat cell_edges_cons !inE.
+  by move: gin=> [] ->; rewrite ?orbT.
+- by move: (closed_events comi)=> /andP[].
+- by move=> e1 e1in; apply: (out_events comi); rewrite inE e1in orbT.
+- by move: (inbox_events comi)=> /andP[].
+- move: (lex_events comi)=> /=.
+  rewrite path_sortedE; last by apply:lexPtEv_trans.
+  by move=> /andP[].
+have xev_ll : p_x (point ev) = left_limit lsto.
+  by rewrite -at_lstx lstx_ll.
+case uocq : (generic_trajectories.update_open_cell _ _ _ _
+  _ _ _ _ _ _ _ _ lsto ev) => [new_opens last_new_open].
+rewrite /state_open_seq/=.
+rewrite -catA -cat_rcons 2!all_cat andbCA.
+move: (sides_ok comi).
+rewrite !all_cat /= andbCA => /andP[] lstook ->; rewrite andbT.
+have sz_lptso := size_left_lsto sval lstx_ll
+    (sides_ok comi) (esym at_lstx) pal (underW puho)
+    => /=.
+have lxlftpts : all (fun x => lexPt x (point ev)) (behead (left_pts lsto)).
+  have := lst_side_lex comng  => /=.
+  case lptsq : (left_pts lsto) => [ | p1 [ | p2 ps]] //= /andP[] p2lex _.
+  rewrite p2lex /=.
+  apply/allP => px pxin.
+  apply: (lexPt_trans _ p2lex).
+  move: (sides_ok comi)=> /allP /(_ _ lstoin) /andP[] _.
+  rewrite lptsq /= => /andP[] /andP[] _ /andP[] p2ll /allP psll.
+  move=> /andP[] /andP[] _ + _.
+  rewrite (path_sortedE (rev_trans (lt_trans)))=> /andP[] /allP cmpy _.
+  rewrite /lexPt (eqP p2ll) (esym (eqP (psll _ pxin))) eqxx.
+  by rewrite (cmpy (p_y px)) ?orbT // map_f.
+apply: (update_open_cell_side_limit_ok oute sval
+    (sides_ok comi) lxlftpts uocq xev_ll puho pal).
+Qed.
+
 Lemma simple_step_disjoint_general_position_invariant
   bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
   lsthe lstx evs :
@@ -5565,7 +5867,7 @@ have := step_keeps_pw_default inbox_es oute rfo cbtom adj sval
       noc pw.
   by rewrite oe oca_eq -catA.
 have right_limit_closed' :
-  {in  rcons(cls ++ 
+  {in  rcons(cls ++
           lstc :: closing_cells (point ev) cc) (close_cell (point ev) lcc) &
      evs, forall c e, right_limit c <= p_x (point e)}.
   have:= step_keeps_right_limit_closed_default inbox_es cbtom adj
@@ -5680,12 +5982,12 @@ Record edge_covered_general_position_invariant (bottom top : edge)
            point e \in (right_pts c : seq pt) /\ point e >>> low c}  ;
    common_inv_ec : common_general_position_invariant bottom top edge_set
      s events;
-   non_in_ec : 
+   non_in_ec :
       {in edge_set & events, forall g e, non_inner g (point e)};
    uniq_ec : {in events, forall e, uniq (outgoing e)};
    inj_high : {in state_open_seq s &, injective high};
-   bot_left_cells : 
-       {in state_open_seq s & events, 
+   bot_left_cells :
+       {in state_open_seq s & events,
           forall c e, lexPt (bottom_left_corner c) (point e)};
    }.
 
@@ -5695,7 +5997,7 @@ Proof.
 by elim: s => [ | c0 s Ih] //=; rewrite cell_edges_cons !inE !orbA Ih.
 Qed.
 
-Lemma bottom_left_start bottom top p : 
+Lemma bottom_left_start bottom top p :
   inside_box bottom top p ->
   open_cell_side_limit_ok (start_open_cell bottom top) ->
   bottom_left_cells_lex [:: start_open_cell bottom top] p.
@@ -5865,9 +6167,9 @@ have noc : {in all_edges (state_open_seq st) (ev :: evs) &, no_crossing R}.
   simple_step. *)
 have lstxneq :  p_x (point ev) != lstx.
   by move: lstxlt; rewrite lt_neqAle eq_sym=> /andP[] /andP[].
-case oca_eq : 
+case oca_eq :
   (opening_cells_aux (point ev) (sort (@edge_below _) (outgoing ev)) le he) =>
-      [nos lno].  
+      [nos lno].
 have Cinv' :=
   simple_step_common_general_position_invariant boxwf nocs' inbox_s oe Cinv.
 have btm_left_lex_e : {in (state_open_seq st), forall c,
@@ -5882,8 +6184,8 @@ have n_inner2 : {in state_open_seq st,
     by move: inbox0 => /andP[].
   rewrite !inE => /orP[/eqP -> | /orP [/eqP -> | hcin ]] //.
   by apply: n_inner; rewrite // inE eqxx.
-have cov' : {in rcons cov_set ev,forall e', 
-  {in outgoing e', forall g, edge_covered g (state_open_seq 
+have cov' : {in rcons cov_set ev,forall e',
+  {in outgoing e', forall g, edge_covered g (state_open_seq
                               (simple_step fc cc lc lcc le he cls lstc ev))
                   (state_closed_seq
                      (simple_step fc cc lc lcc le he cls lstc ev))}}.
@@ -5910,7 +6212,7 @@ have n_inner' : {in s & evs, forall g e, non_inner g (point e)}.
 have uniq' : {in evs, forall e, uniq (outgoing e)}.
   by move=> g gin; apply: uniq_evs; rewrite inE gin orbT.
 have uniq_ev : uniq (outgoing ev) by apply: uniq_evs; rewrite inE eqxx.
-have inj_high' : 
+have inj_high' :
   {in state_open_seq (simple_step fc cc lc lcc le he cls lstc ev) &,
      injective high}.
   have := step_keeps_injective_high_default inbox0 out_e rfo cbtom adj sval
@@ -5927,7 +6229,7 @@ have btm_left_lex' :
   rewrite /simple_step/= /= oe oca_eq /= /state_open_seq /=.
   rewrite catA=> main.
   move=> c e cin ein; apply: main=> //=.
-    move: lexev; rewrite path_sortedE; last by apply: lexPtEv_trans.  
+    move: lexev; rewrite path_sortedE; last by apply: lexPtEv_trans.
     by move=> /andP[] /allP /(_ e ein).
   move: cin; rewrite /generic_trajectories.simple_step.
   by rewrite -/(opening_cells_aux _ _ _ _) oca_eq.
@@ -5981,7 +6283,7 @@ Lemma start_edge_covered_general_position bottom top s closed open evs :
   {in evs, forall e, uniq (outgoing e)} ->
   main_process bottom top evs = (open, closed) ->
   {in events_to_edges evs, forall g, edge_covered g open closed} /\
-  {in evs, forall e, exists2 c, c \in closed & 
+  {in evs, forall e, exists2 c, c \in closed &
       point e \in (right_pts c : seq pt) /\ point e >>> low c}.
 Proof.
 move=> ltev boxwf startok nocs' inbox_s evin lexev evsub out_evs cle
@@ -5999,7 +6301,7 @@ rewrite /initial_state evsq /=.
 case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
 set istate := Bscan _ _ _ _ _ _ _.
 move=> istateP req.
-suff main : forall events op cl st cov_set, 
+suff main : forall events op cl st cov_set,
   edge_covered_general_position_invariant bottom top s cov_set st events ->
   scan events st = (op, cl) ->
   ({in events_to_edges (cov_set ++ events), forall g, edge_covered g op cl} /\
@@ -6049,18 +6351,18 @@ Record safe_side_general_position_invariant (bottom top : edge)
       {subset cell_edges (state_closed_seq s) <= bottom :: top :: edge_set};
    (* TODO : move this to the common invariant. *)
    left_o_lt :
-        {in state_open_seq s & events, 
+        {in state_open_seq s & events,
           forall c e, left_limit c < p_x (point e)};
    left_o_b :
-        {in state_open_seq s, forall c, left_limit c < 
+        {in state_open_seq s, forall c, left_limit c <
               min (p_x (right_pt bottom)) (p_x (right_pt top))};
-   closed_lt : 
+   closed_lt :
         {in state_closed_seq s, forall c, left_limit c < right_limit c};
    closed_ok :
         all (@closed_cell_side_limit_ok R) (state_closed_seq s);
    (* TODO : move this to the disjoint invariant. *)
    cl_at_left_ss :
-     {in state_closed_seq s & events, 
+     {in state_closed_seq s & events,
         forall c e, right_limit c < p_x (point e)};
    safe_side_closed_edges :
      {in events_to_edges processed_set & state_closed_seq s, forall g c p,
@@ -6070,7 +6372,7 @@ Record safe_side_general_position_invariant (bottom top : edge)
          in_safe_side_left p c -> ~p === g};
    safe_side_closed_points :
      {in processed_set & state_closed_seq s, forall e c p,
-         in_safe_side_left p c || in_safe_side_right p c -> 
+         in_safe_side_left p c || in_safe_side_right p c ->
          p != point e :> pt};
    safe_side_open_points :
      {in processed_set & state_open_seq s, forall e c p,
@@ -6138,7 +6440,7 @@ Lemma initial_safe_side_general_position bottom top s events:
     [::(head dummy_event events)]
    (initial_state bottom top events) (behead events).
 Proof.
-move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es 
+move=> gen_pos lexev wf cle startok nocs' n_inner inbox_es sub_es out_es
   uniq_out_es evsn0.
 have := initial_intermediate wf startok nocs' inbox_es lexev sub_es
   out_es cle evsn0.
@@ -6146,7 +6448,7 @@ have := initial_disjoint_general_position_invariant gen_pos wf startok
   nocs' inbox_es lexev sub_es out_es cle evsn0.
 have := initial_edge_covering_general_position gen_pos lexev wf cle
   startok nocs' n_inner inbox_es sub_es out_es uniq_out_es evsn0.
-case evsq: events evsn0=> [ | ev evs]; [by [] | move=> evsn0]. 
+case evsq: events evsn0=> [ | ev evs]; [by [] | move=> evsn0].
 rewrite /initial_state.
 case oca_eq : (opening_cells_aux _ _ _ _) => [nos lno].
 move=> e_inv d_inv.
@@ -6172,7 +6474,7 @@ have dif1 : {in (nos ++ [:: lno]) ++
     by rewrite /opening_cells oca_eq; apply.
   rewrite inE /close_cell (pvertE vb0) (pvertE vt0) => /eqP -> /=.
   by apply/negP=> /eqP abs; move: pab; rewrite abs (underW put).
-have subc1 : {subset cell_edges [:: close_cell (point ev) op0] <= 
+have subc1 : {subset cell_edges [:: close_cell (point ev) op0] <=
     bottom :: top :: s}.
   move=> c; rewrite !mem_cat !inE=> /orP[] /eqP ->.
     have [-> _ _] := close_cell_preserve_3sides (point ev) op0.
@@ -6192,7 +6494,7 @@ have llop0ltev : left_limit op0 < p_x (point ev).
   rewrite (leftmost_points_max startok).
   have := inbox_e=> /andP[] _ /andP[] /andP[] + _ /andP[] + _.
   by case: (lerP (p_x (left_pt bottom)) (p_x (left_pt top))).
-have lltr : {in [:: close_cell (point ev) op0], 
+have lltr : {in [:: close_cell (point ev) op0],
   forall c, left_limit c < right_limit c}.
   move=> c; rewrite inE=> /eqP ->.
   rewrite (@right_limit_close_cell _ (point ev) op0 vb0 vt0).
@@ -6263,8 +6565,8 @@ have op_no_event : {in [:: ev] & nos ++ [:: lno],
 have lt_p_ev :
   {in [:: ev] & evs, forall e1 e2 : event', p_x (point e1) < p_x (point e2)}.
   by move=> e1 e2; rewrite inE => /eqP ->; apply: lte.
-have ll_o_b : 
-  {in nos ++ [:: lno], forall c, 
+have ll_o_b :
+  {in nos ++ [:: lno], forall c,
        left_limit c < min (p_x (right_pt bottom)) (p_x (right_pt top))}.
   move=> c cin.
   have := opening_cells_left oute vb0 vt0; rewrite /opening_cells oca_eq.
@@ -6323,7 +6625,7 @@ have : safe_side_general_position_invariant bottom top s [:: ev]
     nocs' n_inner evin evsub out_evs uniq_edges evsn0.
   by rewrite evsq /= oca_eq.
 move=> invss req.
-suff main: forall events op cl st processed_set, 
+suff main: forall events op cl st processed_set,
   safe_side_general_position_invariant bottom top s processed_set st events ->
   scan events st = (op, cl) ->
   {in cl, forall c,
@@ -6453,7 +6755,7 @@ have oute' :
   {in (sort (@edge_below _) (outgoing ev)), forall g, left_pt g == point ev}.
   by move=> g; rewrite mem_sort; apply: oute.
 set rstate := Bscan _ _ _ _ _ _ _.
-have d_inv': 
+have d_inv':
   disjoint_general_position_invariant bottom top s rstate future_events.
   move: (d_inv); rewrite stq=> d_inv'.
   have := simple_step_disjoint_general_position_invariant boxwf nocs'
@@ -6633,7 +6935,7 @@ have cl_safe_edge :
     by rewrite /closing_cells -map_rcons map_f // => /(_ isT).
   move: gin=> /flatten_mapP[e' e'in gin].
   have := edge_covered_ec e_inv e'in gin=> -[]; last first.
-    move=> [[ | pcc0 pcc] []]; first by []. 
+    move=> [[ | pcc0 pcc] []]; first by [].
     move=> _ /= [pccsub [pcchigh [_ [_ rlpcc]]]] /andP[] _ /andP[] _.
     rewrite leNgt=> /negP; apply.
     rewrite samex -rlpcc; apply:rl; last by rewrite inE eqxx.
@@ -6755,10 +7057,10 @@ have op_safe_edge :
     rewrite ltNge=> /negP; apply.
     by move: pong; rewrite (eqP (oute _ gnew)).
   move=> p pin.
-  have : has (in_safe_side_left p) 
+  have : has (in_safe_side_left p)
            (opening_cells (point ev) (outgoing ev) le he).
     by apply/hasP; exists c; rewrite // /opening_cells oca_eq.
-  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=. 
+  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=.
   move=> /(_ _ _ _ _ _ _ oe p) /eqP <- => /hasP[] c' c'in pin'.
   have := cl_safe_edge _ c' gin; apply.
     by rewrite /rstate /state_closed_seq/= rcons_cat /= mem_cat inE c'in ?orbT.
@@ -6807,10 +7109,10 @@ have op_safe_event :
     apply/eqP=> pev.
     by move: llt; rewrite -pll pev lt_irreflexive.
   move=> p pin.
-  have : has (in_safe_side_left p) 
+  have : has (in_safe_side_left p)
            (opening_cells (point ev) (outgoing ev) le he).
     by apply/hasP; exists c; rewrite // /opening_cells oca_eq.
-  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=. 
+  have := sides_equiv inbox_es oute rfo cbtom adj sval; rewrite stq /=.
   move=> /(_ _ _ _ _ _ _ oe p) /eqP <- => /hasP[] c' c'in pin'.
   have := cl_safe_event _ c' ein; apply.
     by rewrite /rstate /state_closed_seq/= rcons_cat /= mem_cat inE c'in ?orbT.
@@ -6843,8 +7145,8 @@ have lo_lb' : {in state_open_seq rstate, forall c,
   by apply: inside_box_lt_min_right.
 by constructor.
 Qed.
-  
-(*  
+
+(*
 
 Lemma start_cover (bottom top : edge) (s : seq edge) closed open :
   bottom <| top ->
@@ -6887,7 +7189,7 @@ have evsin0 : all (inside_box bottom top)
   have : {subset [seq left_pt g | g <- s] <= inside_box bottom top}.
     by apply/allP: leftin.
   by apply: edges_to_events_subset.
-have btm_left0 : {in [seq point e | e <- evs], 
+have btm_left0 : {in [seq point e | e <- evs],
          forall e,  bottom_left_cells_lex op0 e}.
   move=> ev /[dup] /(allP evsin0) /andP[_ /andP[valb valt]] evin c.
   rewrite /op0 inE /lexPt /bottom_left_corner=> /eqP -> /=.
@@ -7003,7 +7305,7 @@ have cbtomr : cells_bottom_top bottom top op'.
 have sortev' : sorted (@lexPt R) [seq point x | x <- evs'].
   by move: sortev; rewrite /= => /path_sorted.
 have llim' : {in op', forall c p, inside_box bottom top p ->
-                  left_limit c = p_x p -> 
+                  left_limit c = p_x p ->
                   contains_point' p c -> has (inside_closed' p) cl'}.
   by apply: (step_keeps_cover_left_border cbtom
          adj inbox_e sval' oute' rfo clae
@@ -7049,7 +7351,7 @@ have higfc : fc != nil -> high (last dummy_cell fc) = low (head lcc cc).
 move=> le_cnct.
 move=> he_cnct.
 have adjnew : adjacent_cells (fc ++ nos ++ lno :: lc).
-  rewrite (_ : fc ++ nos ++ lno :: lc = 
+  rewrite (_ : fc ++ nos ++ lno :: lc =
                 fc ++ (rcons nos lno) ++ lc);last first.
     by rewrite -cats1 -!catA.
   a d m i t.
diff --git a/theories/math_comp_complements.v b/theories/math_comp_complements.v
index fdc5a5b..a65e6de 100644
--- a/theories/math_comp_complements.v
+++ b/theories/math_comp_complements.v
@@ -269,3 +269,23 @@ Ltac subset_tac :=
   | |- is_true (_ \in (_ ++ _)) => rewrite mem_cat; apply/orP;
     (solve [left; subset_tac] || (right; subset_tac))
   end.
+
+Section mapi.
+
+(* TODO: This might be useful one day, because it is used intensively in the
+  trajectory computation, but not so much in cell decomposition. *)
+Definition mapi [T U : Type] (f : T -> Datatypes.nat -> U) (s : seq T) :=
+  map (fun p => f p.1 p.2) (zip s (iota 0 (size s))).
+
+Lemma nth_mapi [T U : Type] (f : T -> Datatypes.nat -> U) (s : seq T) n d d' :
+  (n < size s)%N ->
+  nth d' (mapi f s) n = f (nth d s n) n.
+Proof.
+rewrite /mapi.
+rewrite -[X in f _ X]addn0.
+elim: s n 0%N => [ | el s Ih] [ | n] m //=.
+  rewrite ltnS=> nlt.
+by rewrite addSn -addnS; apply: Ih.
+Qed.
+
+End mapi.

From 21f975d046c524b129742a0f8bcd1160558d9933 Mon Sep 17 00:00:00 2001
From: "Yves Bertot (he)" <yves.bertot@inria.fr>
Date: Sun, 27 Oct 2024 08:40:34 +0100
Subject: [PATCH 42/43] proved that update_open_cell satisfies the
 common_non_gp_invariant

---
 theories/cells_alg.v     | 141 +++++++++++++++++++++++++++++++--------
 theories/opening_cells.v |  38 ++++++++++-
 2 files changed, 150 insertions(+), 29 deletions(-)

diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index e91c01c..d6dbd89 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -5054,7 +5054,7 @@ move: oeq; rewrite nosq=> oeq.
 rewrite /=.
 rewrite (first_opening_cells_side_char pp ogq vle vhe pal oute oeq).
 rewrite [in X in _ == X]has_rcons.
-rewrite (last_opening_cells_side_char pp ogq vle vhe puh oute oeq).
+rewrite (last_opening_cells_safe_side_char pp ogq vle vhe puh oute oeq).
 rewrite (negbTE (middle_opening_cells_side_char pp ogq vle vhe oute oeq)) orbF.
 case ccq : cc => [ | cc1 cc'].
     move: (oe); rewrite ccq=> oe'.
@@ -5614,6 +5614,46 @@ have ltev1 : all (fun e =>
 by constructor.
 Qed.
 
+Lemma same_x_point_above_low_lsto bottom top s fop lsto lop cls lstc 
+  ev lsthe lstx evs :
+  lstx = p_x (point ev) ->
+  common_non_gp_invariant bottom top s
+    (Bscan fop lsto lop cls lstc lsthe lstx) (ev :: evs) ->
+  point ev >>> low lsto.
+Proof.
+move=> at_lstx comng.
+have comi := ngcomm comng.
+have lstx_ll : lstx = left_limit lsto.
+  rewrite -[lstx]/(lst_x _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
+  by rewrite (lstx_eq comi).
+have := lst_side_lex comng.
+set W := (X in size X); rewrite -/W.
+have : open_cell_side_limit_ok lsto.
+  by apply: (allP (sides_ok comi)); rewrite mem_cat inE eqxx orbT.
+rewrite /open_cell_side_limit_ok => /andP[] _ /andP[] + /andP[] + /andP[].
+move=> + + _ +.
+rewrite -/W.
+  case wq : W => [ | p1 [ | p2 ps]] //= A /andP[] _ higherps + /andP[] ll _.
+  move: A => /andP[] _ /andP[] p2x allx.
+  have lx : p_x (last p2 ps) == left_limit lsto.
+    case : (ps) allx => [ | p3 pst] // /allP; apply=> /=.
+    by rewrite mem_last.
+  have samex : p_x (point ev) = p_x (last p2 ps).
+    by rewrite -at_lstx lstx_ll (eqP lx).
+  have cmpy : p_y (last p2 ps) <= p_y p2.
+    case psq : ps => [ | p3 pst] //.
+    apply ltW.
+    rewrite (path_sortedE (rev_trans lt_trans)) psq in higherps.
+    move: higherps=> /andP[] /allP /(_ (p_y (last p3 pst))) + _.
+    rewrite map_f; last by rewrite mem_last.
+    by move=> /(_ isT).
+  move=> /(under_edge_lower_y samex) ->.
+  rewrite -ltNge.
+  apply: (le_lt_trans cmpy).
+  move: ll; rewrite /lexPt.
+  by rewrite lt_neqAle samex (eqP p2x) eq_sym lx /=.
+Qed.
+
 Lemma update_open_cell_common_invariant
   bottom top s fop lsto lop cls lstc ev
   lsthe lstx evs :
@@ -5649,32 +5689,7 @@ have lstx_ll : lstx = left_limit lsto.
   rewrite -[lstx]/(lst_x _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
   by rewrite (lstx_eq comi).
 have pal : (point ev) >>> low lsto.
-  have := lst_side_lex comng.
-  set W := (X in size X); rewrite -/W.
-  have : open_cell_side_limit_ok lsto.
-    by apply: (allP (sides_ok comi)); rewrite mem_cat inE eqxx orbT.
-  rewrite /open_cell_side_limit_ok => /andP[] _ /andP[] + /andP[] + /andP[].
-  move=> + + _ +.
-  rewrite -/W.
-  case wq : W => [ | p1 [ | p2 ps]] //= A /andP[] _ higherps + /andP[] ll _.
-  move: A => /andP[] _ /andP[] p2x allx.
-  have lx : p_x (last p2 ps) == left_limit lsto.
-    case : (ps) allx => [ | p3 pst] // /allP; apply=> /=.
-    by rewrite mem_last.
-  have samex : p_x (point ev) = p_x (last p2 ps).
-    by rewrite -at_lstx lstx_ll (eqP lx).
-  have cmpy : p_y (last p2 ps) <= p_y p2.
-    case psq : ps => [ | p3 pst] //.
-    apply ltW.
-    rewrite (path_sortedE (rev_trans lt_trans)) psq in higherps.
-    move: higherps=> /andP[] /allP /(_ (p_y (last p3 pst))) + _.
-    rewrite map_f; last by rewrite mem_last.
-    by move=> /(_ isT).
-  move=> /(under_edge_lower_y samex) ->.
-  rewrite -ltNge.
-  apply: (le_lt_trans cmpy).
-  move: ll; rewrite /lexPt.
-  by rewrite lt_neqAle samex (eqP p2x) eq_sym lx /=.
+  by exact: (same_x_point_above_low_lsto at_lstx comng).
 have abovelow : p_x (point ev) = lstx -> (point ev) >>> low lsto by [].
 have noc : {in all_edges (fop ++ lsto :: lop) (ev :: evs) &,
            no_crossing R}.
@@ -5706,7 +5721,7 @@ constructor.
   rewrite -/(point_under_edge _ _) underW /=; last by [].
   by rewrite -/(point ev <<< lsthe) under_lsthe.
 - rewrite -/(update_open_cell lsto ev).
-case uoc_eq : update_open_cell => [nos lno] /=.
+  case uoc_eq : update_open_cell => [nos lno] /=.
   have [case1 | case2]:= update_open_cellE2 oute vl vh sok xev_llo sll pal puho.
     apply/esym.
     have := opening_cells_left oute vl vh.
@@ -5806,6 +5821,76 @@ apply: (update_open_cell_side_limit_ok oute sval
     (sides_ok comi) lxlftpts uocq xev_ll puho pal).
 Qed.
 
+Lemma update_open_cell_common_non_gp_invariant
+  bottom top s fop lsto lop cls lstc ev
+  lsthe lstx evs :
+  bottom <| top ->
+  {in bottom :: top :: s &, forall e1 e2, inter_at_ext e1 e2} ->
+  {in s, forall g, inside_box bottom top (left_pt g) &&
+                   inside_box bottom top (right_pt g)} ->
+  lstx = p_x (point ev) ->
+  (point ev) <<< lsthe ->
+  common_non_gp_invariant bottom top s
+     (Bscan fop lsto lop cls lstc lsthe lstx)
+     (ev :: evs) ->
+  common_non_gp_invariant bottom top s
+     (step (Bscan fop lsto lop cls lstc lsthe lstx) ev)
+    evs.
+Proof.
+move=> bxwf nocs' inbox_s at_lstx under_lsthe comng.
+have comi := ngcomm comng.
+constructor.
+  now apply: update_open_cell_common_invariant.
+rewrite /step/generic_trajectories.step.
+rewrite /same_x at_lstx eqxx /=.
+rewrite -/(point_under_edge _ _) underW /=; last by [].
+rewrite -/(point ev <<< lsthe) under_lsthe.
+case uocq : (generic_trajectories.update_open_cell _ _ _ _ _ _
+  _ _ _ _ _ _ lsto ev) => [nos lno] /=.
+have oute : out_left_event ev.
+  by apply: (out_events comi); rewrite inE eqxx.
+have [clae [sval' [adj [cbtom rfo]]]] := inv1 comi.
+have sval : seq_valid (state_open_seq (Bscan fop lsto lop cls lstc lsthe lstx))
+              (point ev).
+  by case: sval'.
+have lstoin : lsto \in (fop ++ lsto :: lop).
+  by rewrite mem_cat inE eqxx orbT.
+have [vl vh] := (andP (allP sval lsto lstoin)).
+have sok : open_cell_side_limit_ok lsto.
+  by apply: (allP (sides_ok comi)); exact: lstoin.
+have xev_llo : p_x (point ev) = left_limit lsto.
+  by rewrite -at_lstx -(lstx_eq comi).
+have puho : point ev <<< high lsto.
+  move: under_lsthe.
+  rewrite -[lsthe]/(lst_high _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
+  by rewrite -(high_lsto_eq comi).
+have pal : (point ev) >>> low lsto.
+  by exact: (same_x_point_above_low_lsto at_lstx comng).
+have lstx_ll : lstx = left_limit lsto.
+  rewrite -[lstx]/(lst_x _ _ (Bscan fop lsto lop cls lstc lsthe lstx)).
+  by rewrite (lstx_eq comi).
+have sll : (1 < size (left_pts lsto))%N.
+  by apply: (size_left_lsto sval lstx_ll (sides_ok comi) (esym at_lstx) pal
+             (underW puho)).
+have [case1 | case2]:= update_open_cellE2 oute vl vh sok xev_llo sll pal puho.
+   rewrite /update_open_cell uocq /= in case1.
+   rewrite case1.
+   case oca_eq : (opening_cells_aux _ _ _ _) => [nos1 lno1] /=.
+   have  [sz prf]:= last_opening_cells_left_pts_prefix vl vh puho oute oca_eq.
+   rewrite sz /=.
+   set thenth := nth _ _ _.
+   suff -> : thenth = point ev.
+     rewrite (@path_map _ _ (@point) (@lexPt R) ev evs).
+     exact: (lex_events comi).
+  have := take_nth dummy_pt sz; rewrite prf /thenth.
+  case lpts1 : (left_pts lno1) sz => [ | a [ | b tl]] //= _.
+  by move=> [] _ /esym.
+rewrite /update_open_cell uocq /= in case2.
+rewrite case2 /=.
+rewrite (@path_map _ _ (@point) (@lexPt R) ev evs).
+exact: (lex_events comi).
+Qed.
+
 Lemma simple_step_disjoint_general_position_invariant
   bottom top s fop lsto lop fc cc lcc lc le he cls lstc ev
   lsthe lstx evs :
diff --git a/theories/opening_cells.v b/theories/opening_cells.v
index fb4f971..9a70026 100644
--- a/theories/opening_cells.v
+++ b/theories/opening_cells.v
@@ -940,7 +940,43 @@ rewrite -[pt_eqb _ _ _ _]/(_ == _ :> pt).
 by move=> /eqP <-; rewrite (@mem_head pt).
 Qed.
 
-Lemma last_opening_cells_side_char e le he pp nos lno :
+Lemma last_opening_cells_left_pts_prefix e le he nos lno :
+  valid_edge le (point e) ->
+  valid_edge he (point e) ->
+  point e <<< he ->
+  out_left_event e ->
+  opening_cells_aux (point e) (sort (@edge_below _) (outgoing e)) le he =
+    (nos, lno) ->
+  (1 < size (left_pts lno))%N  /\
+  take 2 (left_pts lno) =
+    [:: Bpt (p_x (point e)) (pvert_y (point e) he); (point e)] .
+Proof.
+move=> + vh puh oute.
+have := outleft_event_sort oute.
+elim: (sort _ _) nos lno le => [ | g s Ih] nos lno le /= oute' vl.
+  do 2 rewrite -/(vertical_intersection_point _ _).
+  rewrite (pvertE vl) (pvertE vh) => -[nosq lnoq].
+  rewrite -lnoq /=.
+  rewrite -/(_ == point e) -/(point e == _).
+  set ph := (X in X == point e); set pl := (X in point e == X).
+  rewrite -/ph -/pl.
+  have /negbTE -> : ph != point e.
+    rewrite pt_eqE negb_and /ph /= eqxx /=.
+    move: puh.
+    by rewrite (strict_under_pvert_y vh) lt_neqAle eq_sym=> /andP[].
+  split; first by case: (_ == _).
+  by have [-> | enqpl] := eqVneq (point e) pl.
+rewrite -/(vertical_intersection_point _ _).
+rewrite (pvertE vl).
+case oca_eq : (opening_cells_aux _ _ _ _) => [nos1 lno1] [_ <-].
+have oute1 : forall ed, ed \in s -> left_pt ed == point e.
+  by move=> ed edin; apply: oute'; rewrite inE edin orbT.
+have vg : valid_edge g (point e).
+  by rewrite -(eqP (oute' g _)) ?valid_edge_left // inE eqxx.
+by apply: (Ih nos1 lno1 g oute1 vg oca_eq).
+Qed.
+
+Lemma last_opening_cells_safe_side_char e le he pp nos lno :
   outgoing e != [::] ->
   valid_edge le (point e) ->
   valid_edge he (point e) ->

From ef307d317b60bbc2c69c830e74737842b284ae1a Mon Sep 17 00:00:00 2001
From: Yves Bertot <Yves.Bertot@inria.fr>
Date: Wed, 30 Oct 2024 15:40:46 +0100
Subject: [PATCH 43/43] replace seq_subst by an implementation based on map

---
 theories/cells_alg.v             |  4 ++--
 theories/math_comp_complements.v | 23 ++++++++++++-----------
 2 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/theories/cells_alg.v b/theories/cells_alg.v
index d6dbd89..7ec4699 100644
--- a/theories/cells_alg.v
+++ b/theories/cells_alg.v
@@ -3768,7 +3768,7 @@ Lemma connect_limits_seq_subst (l : seq cell) c c' :
   connect_limits l -> connect_limits (seq_subst l c c').
 Proof.
 move=> ll rr; elim: l => [ | a [ | b l] Ih] /=; first by [].
-  by case: ifP.
+  by [].
 move=> /[dup] conn /andP[ab conn'].
 have conn0 : path (fun c1 c2 => right_limit c1 == left_limit c2) a (b :: l).
    by exact: conn.
@@ -3826,7 +3826,7 @@ case: ecg => [[oc [pcc [ocP1 [hP [cP [ocin conn]]]]]] | ].
     rewrite connect_limits_rcons; last by apply/eqP/rcons_neq0.
     move=> /andP[] cP cc.
     rewrite connect_limits_rcons; last first.
-      by case: (pcc')=> /= [ | ? ?]; case: ifP.
+      by case: (pcc')=> /= [ | ? ?].
     apply/andP; split; last first.
       rewrite -cats1 seq_subst_cat /=.
       move: cc; rewrite last_rcons=> /eqP <-.
diff --git a/theories/math_comp_complements.v b/theories/math_comp_complements.v
index a65e6de..7e5e32a 100644
--- a/theories/math_comp_complements.v
+++ b/theories/math_comp_complements.v
@@ -10,12 +10,8 @@ Import Order.TTheory GRing.Theory Num.Theory Num.ExtraDef Num.
 
 Open Scope ring_scope.
 
-Fixpoint seq_subst {A : eqType}(l : seq A) (b c : A) : seq A :=
-  match l with
-  | nil => nil
-  | a :: tl =>
-    if a == b then (c :: seq_subst tl b c) else (a :: seq_subst tl b c)
-  end.
+Definition seq_subst {A : eqType} (l : seq A) (b c : A) : seq A :=
+  map [eta id with b |-> c] l.
 
 Lemma mem_seq_subst {A : eqType} (l : seq A) b c x :
   x \in (seq_subst l b c) -> (x \in l) || (x == c).
@@ -25,16 +21,21 @@ rewrite /=.
 by case: ifP => [] ?; rewrite !inE=> /orP[ | /Ih /orP[] ] ->; rewrite ?orbT.
 Qed.
 
+Lemma map_nilp {A B : Type} (f : A -> B) (l : seq A) :
+  nilp [seq f x | x <- l] = nilp l.
+Proof. by case: l. Qed.
+
+Lemma map_eq0 {A B : eqType} (f : A -> B) (l : seq A) :
+  ([seq f x | x <- l] == [::]) = (l == [::]).
+Proof. by case: l. Qed.
+
 Lemma seq_subst_eq0  {A : eqType} (l : seq A) b c :
   (seq_subst l b c == [::]) = (l == [::]).
-Proof. by case : l => [ | a l] //=; case: ifP. Qed.
+Proof. exact: map_eq0. Qed.
 
 Lemma seq_subst_cat {A : eqType} (l1 l2 : seq A) b c :
   seq_subst (l1 ++ l2) b c = seq_subst l1 b c ++ seq_subst l2 b c.
-Proof.
-elim: l1 => [ // | a l1 Ih] /=.
-by case: ifP=> [ab | anb]; rewrite Ih.
-Qed.
+Proof. exact: map_cat. Qed.
 
 Lemma last_in_not_nil (A : eqType) (e : A) (s : seq A) :
 s != [::] -> last e s \in s.