(*========================================================== ============================================================ AUGUST 2008 TOPOLOGICAL FMAPS, HMAPS - WITH EMBEDDINGS AND TAGS  (2008 RING FORMALIZATION)  PART 1: BASES, FMAPS, HMAPS, CLOSURES OF A, A_1  COMPLETE: OK! ============================================================ ==========================================================*)
(* cd Desktop/JFD/JFD08/GALAPAGOS/HMAPSTE_08 coqtop -opt *)
Global Set Asymmetric Patterns.
Require Export Reals.
Require Export Omega.
Open Scope R_scope.
(*======================================================== DIMENSIONS ========================================================*)
(* Dimensions: *)
Inductive dim:Set := zero : dim | one : dim.
(* Decidability of point equality: OK, but DANGEREOUS ! *)
(*======================================================== DARTS AS NATURALS ========================================================*)
(* For simplicity, dart is nat, but it could be a deferred type: *)
Definition dart := nat.
(* Decidability of dart equality: *)
Definition eq_dart_dec := eq_nat_dec.
(* Nil dart: *)
Definition nil := 0%nat.
(*======================================================== FREE MAPS, CONSTRUCTORS, OBSERVERS AND DESTRUCTORS ========================================================*)
Open Scope Z_scope.
(* Free maps: *)
Inductive fmap:Set :=
V : fmap
| I : fmap->dart->tag->point->fmap
| L : fmap->dim->dart->dart->fmap.
(* Map emptiness: *)
Definition empty(m:fmap): Prop:=
match m with
V => True
|  _ => False
end.
(* Map emptiness is decidable: *)
(* and the variant: *)
(* Relationship between succ and exd: *)
(* Idem: *)
(* Idem with: *)
(* Note that, in a hmap m, we have neither exd m z -> A m k z <> nil nor exd m z -> A_1 m k z <> nil *)
(* Note also: *)
(* Idem: *)
(* IDEM: *)
(*========================================================= A AND A_1 ARE INVERSES INJECTIONS IN A hmap: ==========================================================*)
(* In a qmap, A et A_1 are inverses: *)
(* 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): OK *)
(* Idem, for pred and A_1: *)
(*========================================================== PROPERTIES of A and A_1 CLOSURES in hmap ==========================================================*)
(* Each existing dart has a succ in the k-closure : *)
(* Each dart of a fmap has a succ and a pred for the closure: *)
(* If the succ for cA is in the hmap, the initial dart also: *)
(* Idem for cA_1: *)
(* A non existing dart has a nil successor by cA: *)
(* Idem for cA_1: *)
(* Inverse for exd: *)
(* Idem: *)
(* Specializations: *)
(* cA and cA_1 are inverses of each other: *)
(* IDEM: *)
(* (cA m k) in an injection on (exd m): *)
(* Idem: cA_1 is an injection on exd: *)
(* Isolated darts are fixpoints for the closure:*)
(* Preservation of the existing successors in the closure: *)
(* IDEM: Preservation of the existing predecessors: *)
(* Definition of the notion of surjection on a domain: *)
Definition surj_dart(Df:dart->Prop)(f:dart->dart):Prop :=
forall y:dart, Df y ->
exists x : dart, Df x /\ f x = y.
(* (cA m k) is surjective on (exd m): *)
(* IDEM: *)
(* Notion of bijection: *)
Definition bij_dart(Df:dart->Prop)(f:dart->dart):Prop:=              inj_dart Df f /\ surj_dart Df f.
(* (cA m k) is bijective on (exd m): *)
(* IDEM: *)
(*========================================================== exd, A, A_1 on D for hmap ==========================================================*)
(* Action of D on exd: *)
(*========================================================= PROPERTIES OF DESTRUCTORS B, B_1 on exd ========================================================*)
(* Action of B on exd: *)
(* Action of B_1 on exd: *)
induction m.
simpl in |- *.
tauto.
simpl in |- *.
intros.
generalize (IHm k x z).
tauto.
simpl in |- *.
intros k x z.
elim (eq_dim_dec d k).
elim (eq_dart_dec d1 x).
generalize (IHm k x z).
tauto.
simpl in |- *.
generalize (IHm k x z).
tauto.
simpl in |- *.
intro.
apply IHm.
Qed.
(* IDEM: *)
(*========================================================== A, A_1 on B, B_1 for hmap : OK ==========================================================*)
(* 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: OK *)
(* Action_bis of B on A_1 : OK*)
(* Action_ter of B on A_1: IDEM *)
(* SYMMETRICALLY, WE HAVE: *)
(* Action of B_1 on A_1: IDEM *)
(* Action_bis of B_1 on A_1: IDEM *)
(* TEST: OK: ALL CAN BE REVISED MORE SIMPLY ?...  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: IDEM *)
(* Action_bis of B_1 on A: IDEM: A FAIRE *)
(* Action_ter of B_1 on A: IDEM: *)
(*=========================================================== top, bottom  ============================================================*)
(* top AND bottom :*)
Fixpoint top
(m:fmap)(k:dim)(z:dart){struct m}:dart:=
match m with
V => nil
|  I m0 x _ _ =>
if eq_dart_dec x z then z
else top m0 k z
|  L m0 k0 x y =>
if eq_dim_dec k0 k
then
if eq_dart_dec x (top m0 k0 z)
then top m0 k0 y
else top m0 k0 z
else top m0 k z
end.
Fixpoint bottom
(m:fmap)(k:dim)(z:dart){struct m}:dart:=
match m with
V => nil
|  I m0 x _ _ =>
if eq_dart_dec x z then z
else bottom m0 k z
|  L m0 k0 x y =>
if (eq_dim_dec k0 k)
then
if eq_dart_dec y (bottom m0 k0 z)
then bottom m0 k0 x
else bottom m0 k0 z
else bottom m0 k z
end.
(* OK : *)
(* IDEM: A FAIRE *)
(* OK: *)
(* IDEM: A FAIRE *)
(* OK: *)
(* OK: *)
(* IDEM: *)
(* OK: top_bottom is a COROLLARY.. CHANGING NAMES ?... *)
(* IDEM: *)
(* OK: *)
(* IDEM: *)
(* OK: *)
(* OK, WITHOUT exd m z : *)
(* IDEM: *)
(* IDEM: WITHOUT exd m z: *)
(* OK: *)
(* IDEM: *)
(* OK: *)
(* IDEM: *)
(* IDEM: *)
(* OK: *)
(* IDEM: *)
(* OK: *)
(* IDEM: *)
(* IDEM:*)
(* OK: *)
(* IDEM: *)
(* OK:*)
(* IDEM: *)
induction m.
simpl in |- *.
tauto.
simpl in |- *.
unfold prec_I in |- *.
intros.
elim (eq_dart_dec d z).
elim (eq_dart_dec d z).
tauto.
tauto.
intro.
elim (eq_dart_dec d (bottom m k z)).
intro.
rewrite a in H.
absurd (exd m (bottom m k z)).
tauto.
apply exd_bottom.
tauto.
tauto.
intro.
apply IHm.
tauto.
tauto.
simpl in |- *.
unfold prec_L in |- *.
intros.
elim (eq_dim_dec d k).
elim (eq_dart_dec d1 (bottom m d z)).
elim (eq_dart_dec d1 (bottom m d d0)).
intros.
decompose [and] H.
clear H.
generalize H7.
rewrite cA_eq in |- *.
elim (succ_dec m d d0).
tauto.
symmetry  in a.
tauto.
tauto.
elim (eq_dart_dec (cA m k d0) (bottom m d d0)).
elim (eq_dart_dec d0 (top m d z)).
intros.
rewrite <- a2 in |- *.
apply cA_1_top.
tauto.
tauto.
tauto.
intros.
rewrite a0 in |- *.
rewrite a1 in |- *.
apply IHm.
tauto.
tauto.
intros.
elim b.
rewrite <- a0 in |- *.
apply cA_bottom.
tauto.
tauto.
tauto.
elim (eq_dart_dec d1 (bottom m d z)).
tauto.
intros.
elim (eq_dart_dec (cA m k d0) (bottom m d z)).
intros.
elim (eq_dart_dec d0 (top m d z)).
intro.
rewrite <- a in |- *.
apply cA_1_top.
tauto.
tauto.
tauto.
intro.
rewrite <- a in a0.
assert (d0 = cA_1 m d (bottom m d z)).
rewrite <- a0 in |- *.
rewrite cA_1_cA in |- *.
tauto.
tauto.
tauto.
rewrite IHm in H1.
tauto.
tauto.
tauto.
intros.
elim (eq_dart_dec d0 (top m d z)).
intros.
rewrite <- IHm in a0.
assert (cA m k d0 = bottom m d z).
rewrite a0 in |- *.
rewrite <- a in |- *.
rewrite cA_cA_1 in |- *.
tauto.
tauto.
apply exd_bottom.
tauto.
tauto.
tauto.
tauto.
tauto.
intro.
rewrite a in |- *.
apply IHm.
tauto.
tauto.
intro.
apply IHm.
tauto.
tauto.
Qed.
(* IDEM: *)
(*=======================================================  B, B_1 ON cA, cA_1  =========================================================*)
(* OK: VERY LONG *)
(* cA_cA_1_B is defined *)
(* COROLLARIES : *)
(* COROLLARIES: *)
(* COROLLARIES : *)
(*=======================================================  B and B_1 PRESERVE inv_hmap:  =======================================================*)
(* OK : *)
(* B_1 is defined from B: *)
(* IDEM: B_1 preserves inv_hmap : A FAIRE *)

Lemma inv_hmap_B_1 : forall (m:fmap)(k:dim)(x:dart),
inv_hmap m -> inv_hmap (B_1 m k x).