(*========================================================== ============================================================  TOPOLOGICAL FMAPS, QHMAPS, HMAPS -  PROOFS OF THE GENUS THEOREM AND THE EULER RELATION  PART 1: BASES, FMAPS, QHMAPS, HMAPS, CLOSURES OF A, A_1  (J.-F. Dufourd, June 2006 - FOR PUBLICATION completed in October 2007)  ============================================================ ==========================================================*)
(* coqtop -opt *)
Global Set Asymmetric Patterns.
(*======================================================== DIMENSIONS ========================================================*)
(* Dimensions: *)
Inductive dim:Set := di0 : dim | di1 : dim.
(* Action of B_1 on exd: *)
induction m.
simpl in |- *.
tauto.
simpl in |- *.
intros.
generalize (IHm k x y).
tauto.
simpl in |- *.
intros k x y.
elim (eq_dim_dec k d).
elim (eq_dart_dec x d1).
generalize (IHm k x y).
tauto.
simpl in |- *.
generalize (IHm k x y).
tauto.
simpl in |- *.
intro.
apply IHm.
Qed.
(*========================================================== I- AND L-PRECONDITIONS, QUASI-HMAPS ==========================================================*)
(* For a unique insertion of a non nil dart in a (future) qhmap: *)
Definition prec_I (m:fmap)(x:dart):=
x <> nil /\ ~ exd m x .
(* For correctness of functional link insertion, maybe incomplete, in a (future) qhmap: *)
Definition prec_Lq (m:fmap)(k:dim)(x y:dart) :=
exd m x /\ exd m y /\ ~ succ m k x /\ ~ pred m k y.
(* Quasi-map's topological invariant: in 2 parts *)
Fixpoint inv_qhmap(m:fmap){struct m}:Prop:=
match m with
V => True
| I m0 x0 => inv_qhmap m0
/\ prec_I m0 x0
| L m0 k0 x0 y0 => inv_qhmap m0
/\ prec_Lq m0 k0 x0 y0
end.
(* Definition of the qhmap type: (not used) *)
Definition qhmap:Set := {m:fmap | inv_qhmap m}.
(* Projection of a qhmap to its fmap support: *)
Definition qhmap_to_fmap(q:qhmap):fmap:=
match q with exist m _=> m end.
(* The projection is declared as a coercion: *)
Coercion qhmap_to_fmap: qhmap >-> fmap.
(*========================================================= A LOT OF PROPERTIES NEEDING inv_qhmap ONLY ==========================================================*)
(* nil isn't in a qhmap: *)
(* and the inverse: *)
(* Relationship between succ and exd: *)
(* Idem with pred and exd: *)
(* A non existing dart has no successor: *)
(* Idem: *)
(* Note that, in a qmap m, it is not True that: exd m x -> A m k x <> nil, exd m x -> A_1 m k x <> nil *)
(* Note also: *)
(* A true successor always exists: *)
(* Idem with: *)
(* Inverses: *)
(* Idem: *)
(*========================================================= A AND A_1 ARE INVERSE INJECTIONS IN A qhmap: ==========================================================*)
(* In a qmap, A et A_1 are inverses of each other: *)
(* Idem with A_1: *)
(* Partial injection on dart, Df giving the domain of f: *)
Definition inj_dart(Df:dart->Prop)(f:dart->dart):Prop:=
forall x x':dart,
(Df x)->(Df x')->(f x)=(f x')->x=x'.
(* (A m k) is an injection on (succ m k): *)
(* Idem, for pred and A_1*)
(* Idem: (A_1 m k) is an injection on (pred m k): *)
(*========================================================== CLOSURES of A AND A_1 IN qhmap ==========================================================*)
(* Closures of A and A_1, together designed for qhmaps, mutually recursive: *)
Fixpoint cA
(m:fmap)(k:dim)(x:dart){struct m}:dart:=
match m with
V => nil
|  I m0 x0 =>
if eq_dart_dec x x0 then x
else cA m0 k x
|  L m0 k0 x0 y0 =>
if (eq_dim_dec k k0)
then
if (eq_dart_dec x x0) then y0
else
if (eq_dart_dec x (cA_1 m0 k y0))
then cA m0 k x0
else cA m0 k x
else cA m0 k x
end
with cA_1
(m:fmap)(k:dim)(x:dart){struct m}:dart:=
match m with
V => nil
|  I m0 x0 =>
if eq_dart_dec x x0 then x
else cA_1 m0 k x
|  L m0 k0 x0 y0 =>
if (eq_dim_dec k k0)
then
if (eq_dart_dec x y0) then x0
else
if (eq_dart_dec x (cA m0 k x0))
then cA_1 m0 k y0
else cA_1 m0 k x
else cA_1 m0 k x
end.
(* Notations ? Notation "A~" := cA.  Notation "A_1~" := cA_1.  Notation "A~" := cA.  Notation "A_1~" := cA_1. *)
(* In fact, a qhmap m equipped with (cA m di0) and (cA m di1) is a hmap: cf. below. *)
(* Each dart of an fmap has a succ and a pred in the closure: *)
(* Each dart of a qhmap has a succ and a pred for the closure: *)
(* If the succ for cA is in the qhmap, the initial dart also: *)
(* Idem for cA_1: *)
(* Inverse for exd: *)
(* Idem: *)
(* cA and cA_1 are inverses of each other: *)
(* IDEM: the inverse: *)
(* (cA m k) in an injection on (exd m): *)
(* Idem: cA_1 is an injection on exd: *)
(* Isolated darts are fixpoints for the the closure:*)
(* Preservation of the existing successors in the closure: *)
(* IDEM: Preservation of the existing predecessors: *)
(*========================================================== A, A_1 on B, B_1 for qhmap ==========================================================*)
(* Action_bis of B on A: OK *)
(* Action_ter of B on A: OK *)
(* USEFUL LEMMAS *)
(* Deleting a link from an inexisting dart has no effect: *)
(* Corollary: deleting a link from nil has no effect: *)
(* IDEM: *)
(* Action of B on A_1: *)
(* Action_bis of B on A_1: *)
(* Action_ter of B on A_1: IDEM *)
(* SYMMETRICALLY, WE HAVE: *)
(* Action of B_1 on A_1: *)
(* Action_bis of B_1 on A_1: *)
(* TEST: OK ... Lemma A_1_B_1_bis_bis : forall (m:fmap)(k:dim)(x y:dart), y <> x -> A_1 (B_1 m k x) k y = A_1 m k y. *)
(* Action_ter of B_1 on A: *)
(* Action of B_1 on A: *)
(* Action_bis of B_1 on A: *)
(* Action_ter of B_1 on A: *)
(*======================================================= PROPERTIES of B and B_1 on inv_qhmap: =======================================================*)
(* B preserves inv_qhmap: *)
(* IDEM: B_1 preserves inv_qhmap: *)
(*======================================================== HMAPS ========================================================*)
(* HYPOTHESIS: a hmap could be viewed as a qhmap with the closed version of A. Hier, it is considered as a completely sewn qhmap, which is approximately the same... *)
(* Invariant of the hypermaps: inv_qhmap + completeness *)
Definition inv_hmap(m:fmap):Prop :=
inv_qhmap m
/\ forall (x:dart)(k:dim), exd m x ->
succ m k x /\ pred m k x.
(* Definition of the hypermaps: *)
Definition hmap:Set := {m:fmap | inv_hmap m}.
(* Surjection, bijection on the fmap darts: *)
Definition surj_dart(Df:dart->Prop)(f:dart->dart):Prop:=
forall y:dart, Df y ->
exists x:dart, Df x /\ f x = y.
Definition bij_dart(Df:dart->Prop)(f:dart->dart):Prop:=
inj_dart Df f /\ surj_dart Df f.
(* Fundamental property: A and A_1 are injections on the hypermap supports: *)
(* IDEM : *)
(* Fundamental property: A_1 k is a partial surjection in hypermaps: OK *)
(* First, on domain (succ m k): *)
(* Second, on domain (exd m): *)
(* Fundamental property: A k is a partial surjection in hypermaps: *)
(* First, on domain (succ m k): *)
(* Second, on domain (exd m): *)
(* Fundamental theorem: (A m k) is a bijection on hmap support (exd m): *)
(*======================================================== 8 "LITTLE" LEMMAS ON qhmaps WHICH ARE USEFUL IN THE PROOF OF CLOSURE CORRECTION =========================================================*)
(* A on x0: *)
(* A on y0: *)
(* A on xk := A m k x0 : *)
(* A on yk:= (A_1 m k y0): *)
(* THE SYMMETRICS, PROVEN TOO: *)
(* A_1 on y0: *)
(* A_1 on x0: *)
(* A_1 on yk: *)
(* A_1 on xk: *)
(*========================================================== TOPOLOGICAL HMAP OPERATIONS ==========================================================*)
(* Empty hmap: *)
Definition v:= V.
(* Insertion of an isolated dart, sewn to itself: *)
Definition prec_i (m:fmap)(x:dart):=
prec_I m x.
Definition i(m:fmap)(x:dart):=
L (L (I m x) di0 x x) di1 x x.
(* Correction of i for hmaps: proof obligation: *)
(* Changing k-links: effect: breaking/merging of orbits *)
(* Precondition for hmaps: *)
Definition prec_lh (m:fmap)(k:dim)(x y:dart)
:= exd m x /\ exd m y /\ y <> A m k x.
(* Note that the construction of fixpoints is allowed: *)
Definition l (m:fmap)(k:dim)(x y:dart) :=
let xk  := (A m k x) in
let y_k := (A_1 m k y) in
let m1 := (B_1 (B m k x) k y) in
(L (L m1 k x y) k y_k xk).
intros.
unfold xk in |- *; unfold yk in |- *.
split.
intro.
intro.
assert (y = A m k x).
apply A_1_A.
unfold inv_hmap in H; tauto.
tauto.
tauto.
symmetry  in |- *.
tauto.
tauto.
intro.
intro.
assert (x = A_1 m k y).
apply A_A_1.
unfold inv_hmap in H; tauto.
tauto.
tauto.
tauto.
rewrite H4 in H2.
tauto.
Qed.
(*======================================================== Correction of l for hmaps : PROOF OBLIGATION ========================================================*)
(* BY PARTS: *)
(* From qhmap, by B then by B_1, we arrive in qhmap: *)
(* Precondition for sewing in a qhmap is satified: *)
(* The following needs a hmap: *)
(* First PART: *)

Lemma inv_hmap_l_1:
forall (m:fmap)(k:dim)(x y:dart),
inv_hmap m -> prec_lh m k x y -> inv_qhmap (l m k x y).