Require Export Ensemble.

(* General topology *)

(* topological spaces *)
Definition Topology X cT := cT ⊂ cP(X) ∧
  X ∈ cT ∧ ∅ ∈ cT ∧ (∀ A B, A ∈ cT → B ∈ cT → A ∩ B ∈ cT) ∧
  (∀ cT1, cT1 ⊂ cT → ∪cT1 ∈ cT).

Definition inDiscrete X := [X] ⋃ [∅].
Definition Discrete X := cP(X).

Example inDiscreteT : ∀ X, Ensemble X → Topology X (inDiscrete X).
Proof.
  intros. unfold inDiscrete. repeat split; intros.
  intros x Hx; unH; sing H0; ens. AppCG; ens. apply EmptySub.
  AppCG; ens. AppCG; ens. apply IntSinEm; auto. apply EleUSinEm; auto.
Qed.

Example DiscreteT : ∀ X, Ensemble X → Topology X (Discrete X).
Proof.
  intros. unfold Discrete; repeat split; ens; intros.
  apply PowerI; auto; apply EmptySub. pow H0; pow H1. AppCG.
  apply InterEns; eens. intros x Hx; inH; auto.
  AppCG. eens. intros x Hx; eleU Hx; apply H0 in H2; pow H2.
Qed.

(* neighborhood system *)
Definition Neigh x U X cT := Topology X cT ∧ x ∈ X ∧ U ⊂ X ∧
  ∃ V, V ∈ cT ∧ x ∈ V ∧ V ⊂ U.
Definition NeighS x X cT := \{λ U, Neigh x U X cT\}.

Fact neighF : ∀ x U X cT, Topology X cT → x ∈ U → U ∈ cT → Neigh x U X cT.
Proof.
  intros. assert (U ⊂ X). apply H in H1; pow H1.
  red; andG; auto. exists U; andG; ens.
Qed.

Fact neigh_F1 : ∀ x U X cT,
  Ensemble X → Neigh x U X cT ↔ U ∈ NeighS x X cT.
Proof. split; intros. AppCG. eapply SubAxP; eauto. apply H0. AppC H0. Qed.

Definition EleUx x U cT := ∪\{λ V, x ∈ U ∧ V ∈ cT ∧ x ∈ V ∧ V ⊂ U \}.

Lemma Le_NeFa : ∀ U, U = ∪(\{λ t, ∃ x, x ∈ U ∧ t = [x]\}).
Proof.
  intro. AppE; AssE x. AppCG. exists [x]. andG; ens. AppCG; ens.
  eleU H. AppC H1; destruct H1; andH. subst. sing H; Ens.
Qed.

Theorem neigh_T : ∀ U X cT, Ensemble X → Topology X cT → U ⊂ X →
  (U ∈ cT ↔ ∀ x, x ∈ U → U ∈ NeighS x X cT).
Proof.
  intros * Hxe Ht Hs. split; intros Hp.
  - intros. apply neigh_F1, neighF; auto.
  - DC (U = ∅). subst; apply Ht. set (∪(\{λ t, ∃ x, x ∈ U ∧
      t = EleUx x U cT\})) as Hmi.
    assert (H1 : ∪(\{λ t, ∃ x, x ∈ U ∧ t = [x]\}) ⊂ Hmi).
    { intros z Hz; eleU Hz. AppC H1; destruct H1; andH. subst.
      sing H0; Ens. apply Hp in H1 as Hu. AppC Hu. AppCG; Ens.
      exists (EleUx x0 U cT). andG. AppCG; Ens. destruct Hu as
        [_ [_ [_ [V [Hv []]]]]]. exists V. andG; auto. AppCG; Ens. AppCG.
      apply (SubAxP U); eens. intros z Hz. eleU Hz. AppC H2; andH; auto. }
    rewrite <- Le_NeFa in H1. assert (H2 : Hmi ⊂ U).
    { intros z Hz. eleU Hz. AppC H2; destruct H2; andH.
      subst. eleU H0; AppC H3; andH; auto. } assert (U = Hmi). eens.
    rewrite H0. apply Ht; intros V Hv. AppC Hv; destruct Hv; andH.
    subst V. apply Ht. intros z Hz; AppC Hz; tauto.
Qed.

Theorem neigh_T1a : ∀ x X cT, Ensemble X → Topology X cT → x ∈ X →
  ∀ U V, U ∈ NeighS x X cT → V ∈ NeighS x X cT →
  U ∩ V ∈ NeighS x X cT.
Proof.
  intros * Hxe Ht Hx * Hu Hv.
  apply neigh_F1 in Hu as [_ [_ [Hux [U0 [Ho1 []]]]]]; auto.
  apply neigh_F1 in Hv as [_ [_ [Hvx [V0 [Ho2 []]]]]]; auto.
  apply neigh_F1; auto. red; andG; auto. intros z Hz; inH; auto.
  exists (U0 ∩ V0). andG; ens. apply Ht; auto. intros z Hz; inH; ens.
Qed.

Theorem neigh_T1b : ∀ x X cT, Ensemble X → Topology X cT → x ∈ X →
  ∀ U V, U ∈ NeighS x X cT → V ⊂ X → U ⊂ V → V ∈ NeighS x X cT.
Proof.
  intros * Hxe Ht Hx * Hu Hv Huv.
  apply neigh_F1 in Hu as [_ [_ [Hux [U0 [Ho1 []]]]]]; auto.
  apply neigh_F1; auto. red; andG; auto. exists U0; andG; eens.
Qed.

Theorem neigh_T1c : ∀ x X cT, Ensemble X → Topology X cT → x ∈ X →
  ∀ U, U ∈ NeighS x X cT → ∃ V, V ∈ NeighS x X cT ∧ V ⊂ U ∧
  (∀ y, y ∈ V → V ∈ NeighS y X cT).
Proof.
  intros. apply neigh_F1 in H2 as [_[_[Hu [V [Ho []]]]]]; auto. exists V.
  andG; auto. apply neigh_F1, neighF; auto. apply neigh_T; eens.
Qed.

(* derived *)
Definition Cluster x A X cT := Topology X cT ∧ A ⊂ X ∧ x ∈ X ∧
  ∀ U, Neigh x U X cT → U ∩ (A - [x]) ≠ ∅.
Definition Derived A X cT := \{λ x, Cluster x A X cT\}.

Fact DerivedP : ∀ A X cT, Derived A X cT ⊂ X.
Proof. intros * x Hx. AppC Hx. apply Hx. Qed.

Fact derived_F1 : ∀ x A X cT, Cluster x A X cT ↔ x ∈ Derived A X cT.
Proof. split; intros. AppCG; exists X; apply H. AppC H. Qed.

Fact derived_F2 : ∀ x A X cT, Topology X cT → A ⊂ X → x ∈ X →
  x ∉ Derived A X cT → ∃ U, Neigh x U X cT ∧ U ∩ (A - [x]) = ∅.
Proof.
  intros * Ht Hs Hx Hp. DC (∃ U, Neigh x U X cT ∧ U ∩ (A - [x]) = ∅).
  auto. elim Hp; apply derived_F1; red; andG; eauto.
Qed.

Theorem derived_Ta : ∀ A B X cT, B ⊂ X → A ⊂ B → Derived A X cT ⊂ Derived B X cT.
Proof.
  intros * Hb Hs x Hx. apply derived_F1 in Hx. red in Hx; andH.
  apply derived_F1. red; andG; auto. intros U Hu. apply H2 in Hu.
  apply EmptyNE in Hu as [y]. inH; smH.
  apply EmptyNE. exists y; inG; smG; auto.
Qed.

Theorem derived_Tb : ∀ A B X cT, Ensemble X → A ⊂ X → B ⊂ X →
  Derived (A ⋃ B) X cT = Derived A X cT ⋃ Derived B X cT.
Proof.
  intros * Hxe Ha Hb. apply IncAsym.
  - intros x Hx. pose proof Hx as Hx'. apply derived_F1 in Hx as
      [Ht [_ [Hx _]]]. DC (x ∈ Derived A X cT ⋃ Derived B X cT); auto.
    apply UnionNE in H; andH. apply derived_F2 in H as [U [Hun Hu]];
    apply derived_F2 in H0 as [V [Hvn Hv]]; auto.
    assert (x ∉ Derived (A ⋃ B) X cT).
    { intro. apply derived_F1 in H as [_ [_ [_ Hp]]]. set (U ∩ V) as D.
      assert (D ∈ NeighS x X cT). apply neigh_T1a; auto;
      apply neigh_F1; auto. apply neigh_F1, Hp in H; auto.
      assert (D ∩ (A ⋃ B) - [x] = ∅).
      { assert ((A ⋃ B) - [x] = A - [x] ⋃ B - [x]). AppE. smH; unH; ens.
        unH; smH; smG; ens. rewrite H0, DistribuLI. AppE; [|exfalso0].
        rewrite <- Hu, <- (EmptyU (U ∩ A - [x])), <- Hv.
        unH;inH;smH;AppC H1; andH; [unG|apply UnionI']; inG; smG; auto. }
       auto. } tauto.
  - assert (Derived A X cT ⊂ Derived (A ⋃ B) X cT ∧
      Derived B X cT ⊂ Derived (A ⋃ B) X cT).
    { andG; apply derived_Ta; intros x Hx; unH; ens. }
    andH; intros x Hx; unH; auto.
Qed.

Theorem derived_Tc : ∀ A X cT, Ensemble X → A ⊂ X →
  Derived (Derived A X cT) X cT ⊂ A ⋃ Derived A X cT.
Proof.
  intros * Hxe Ha x Hx. pose proof Hx as Hx'. apply derived_F1 in Hx as
    [Ht [_ [Hx _]]]. DC (x ∈ A ⋃ Derived A X cT); auto. exfalso.
  apply UnionNE in H as [Hxa Hxd]. apply derived_F2 in Hxd as
    [U [Hun Hue]]; auto. apply neigh_F1 in Hun as Hun'; auto.
  apply neigh_T1c in Hun' as [V [Hvn [Hvu Hp]]]; auto.
  apply neigh_T in Hp as Hp'; auto; [|apply neigh_F1 in Hvn; auto;
  eapply IncTran; eauto; apply Hun]. assert (V ∩ A - [x] = ∅).
  { AppE; [|exfalso0]. rewrite <- Hue. inH; smH. inG; smG; auto. }
  assert (V ∩ A = ∅). { eapply InterEqEmI; revgoals; eauto; Ens. }
  assert (∀ y, y ∈ V → y ∉ A).
  { intros * Hy H1. assert (y ∈ V ∩ A); ens. rewrite H0 in H2. exfalso0. }
  assert (∀ y, y ∈ V → V ∩ A - [y] = ∅).
  { intros. AppE; [|exfalso0]. inH; smH. apply H1 in H3; tauto. }
  assert (∀ y, y ∈ V → y ∉ Derived A X cT).
  { intros * Hy H3. apply H2 in Hy as Hyp. apply derived_F1 in H3.
    apply Hp, neigh_F1, H3 in Hy; auto. }
  assert (V ∩ Derived A X cT - [x] = ∅).
  { AppE; [|exfalso0]. inH; smH. exfalso. apply H3 in H4; auto. }
  apply derived_F1 in Hx' as [_ [_ [_ Hx']]].
  AppC Hvn. apply Hx' in Hvn; auto.
Qed.

(* Closed *)
Definition Closed A X cT := Topology X cT ∧ A ⊂ X ∧ Derived A X cT ⊂ A.

Theorem closed_T : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closed A X cT ↔ X - A ∈ cT.
Proof.
  intros * Hxe Ht Hs. pose proof (SetminSubI A X). split; intros Hp.
  - eapply neigh_T; eauto. intros. smH. assert (x ∉ Derived A X cT).
    { intro. apply Hp in H2; tauto. } apply derived_F2 in H2 as
      [U [Hun Hue]]; auto. apply InterEqEmI in Hue; Ens.
    apply neigh_F1; auto. red; andG; auto. destruct Hun as
      [_ [_ [Hu [V [Hv [Hxv Hvu]]]]]]. exists V. andG; auto.
    eapply IncTran; eauto. intros z Hz. smG; auto. intro.
    assert (z ∈ U ∩ A); ens. rewrite Hue in H3; exfalso0.
  - red; andG; auto. intros x Hx. DC (x ∈ A); auto. exfalso.
    assert (x ∈ X - A). { AppC Hx. smG; auto. apply Hx. }
    eapply neigh_T, neigh_F1 in H1; eauto. pose proof Hx.
    apply derived_F1 in Hx as [_ [_ [_ Hx]]]. apply Hx in H1.
    assert (X-A ∩ A-[x] = ∅). AppE; [|exfalso0]; inH; smH; tauto. auto.
Qed.

Corollary closed_C : ∀ A X cT,
  Ensemble X → Topology X cT → A ⊂ X → A ∈ cT → Closed (X - A) X cT.
Proof.
  intros. apply closed_T; auto.
  apply SetminSubI. rewrite TwoCompl; auto.
Qed.

(* closure *)
Definition Closure A X cT := A ⋃ Derived A X cT.

Fact closureP : ∀ A X cT, A ⊂ X → Closure A X cT ⊂ X.
Proof. intros * Ha x Hx. AppC Hx; orH; auto. apply DerivedP in H; auto. Qed.

Fact closure_F1 : ∀ A X cT, A ⊂ Closure A X cT .
Proof. intros * x Hx. AppCG; Ens. Qed.

Fact closure_F2 : ∀ A B X cT, B ⊂ X → A ⊂ B → Closure A X cT ⊂ Closure B X cT.
Proof.
  unfold Closure; intros * Hb Hs x Hx. unH; ens.
  apply UnionI'. eapply derived_Ta; eauto.
Qed.

Fact closure_F3 : ∀ A B X cT, Ensemble X → Topology X cT →
  A ⊂ X → B ⊂ X → Closure (A ⋃ B) X cT = Closure A X cT ⋃ Closure B X cT.
Proof.
  intros * Hxe Ht Ha Hb. unfold Closure. rewrite derived_Tb,
    AssocU, (CommuU B), <- AssocU, <- AssocU, AssocU, (CommuU _ B); auto.
Qed.

Fact closure_F4 : ∀ A B X cT, Ensemble X → Topology X cT →
  A ⊂ X → B ⊂ X → Closure (A ⋃ B) X cT = Closure A X cT ⋃ Closure B X cT.
Proof.
  intros * Hxe Ht Ha Hb. unfold Closure. rewrite derived_Tb,
    AssocU, (CommuU B), <- AssocU, <- AssocU, AssocU, (CommuU _ B); auto.
Qed.

Theorem closure_T : ∀ A X cT, Topology X cT → A ⊂ X →
  Closed A X cT ↔ A = Closure A X cT.
Proof.
  intros * Ht Hs. split.
  - intros [_ [_ Hp]]. unfold Closure. AppE; [|unH]; ens.
  - intros. red; andG; auto. rewrite H at 2; intros z HZ; AppCG; Ens.
Qed.

Theorem closure_T1 : ∀ X cT, Ensemble X → Topology X cT → Closure ∅ X cT = ∅.
Proof.
  intros. pose proof (EmptySub X). symmetry; apply closure_T; auto.
  apply closed_T; auto. rewrite SetminEm; apply H0.
Qed.

Theorem closure_T2 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closure (Closure A X cT) X cT = Closure A X cT.
Proof.
  intros * He Ht Hs. unfold Closure at 2. rewrite closure_F3; auto;
  [|apply DerivedP]. unfold Closure. rewrite AssocU,
    <- (AssocU (Derived A X cT) _ _), IdemU,
    <- AssocU, CommuU, IncU; auto. apply derived_Tc; auto.
Qed.

Fact closure_F5 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closed (Closure A X cT) X cT.
Proof.
  intros * Hxe Ht Hs. apply closure_T; auto.
  apply closureP; auto. rewrite closure_T2; auto.
Qed.

(* Interior *)
Definition Interiorp x A X cT := Neigh x A X cT.
Definition Interior A X cT := \{λ x, Interiorp x A X cT \}.

Fact interiorP : ∀ A X cT, Interior A X cT ⊂ X.
Proof.
  unfold Interior, Interiorp, Neigh.
  intros * z Hz. AppC Hz. andH. destruct H2; andH; auto.
Qed.

Fact interior_F1 : ∀ A X cT, Interior A X cT ⊂ A.
Proof.
  intros * z Hz. AppC Hz; destruct Hz; andH. destruct H2; andH; auto.
Qed.

Fact interior_F2 : ∀ A X cT, Interior A X cT ⊂ Closure A X cT.
Proof. intros. eapply IncTran. apply interior_F1. apply closure_F1. Qed.

Theorem interior_Ta : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Interior A X cT = X - (Closure (X - A) X cT).
Proof.
  intros * Hxe Ht Hs. apply IncAsym; intros x Hx.
  - AppC Hx. assert (Hx' := Hx).
    destruct Hx as [_ [Hx [_ [V [Hv [Hxv Hva]]]]]]. apply Hva in Hxv.
    AppCG; andG; Ens. intro. AppC H; orH. smH; auto. apply derived_F1 in H.
    apply H in Hx'. elim Hx'. AppE. inH; smH; tauto. exfalso0.
  - smH. apply UnionNE in H0 as [Hxi Hc]. apply derived_F2 in Hc as
      [V [Hnv Hc]]; auto; [|apply SetminSubI]. apply InterEqEmI in Hc; Ens.
    apply InterSetmin in Hc; [|apply Hnv]. AppCG; Ens.
    eapply neigh_F1, neigh_T1b; eauto. apply neigh_F1; auto.
Qed.

Theorem interior_Tb : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closure A X cT = X - (Interior (X - A) X cT).
Proof.
  intros * Hxe Ht Hs. pose proof (SetminSubI A X) as Hc.
  eapply interior_Ta in Hc; eauto. erewrite TwoCompl in Hc; auto.
  apply (SetminEq _ _ X) in Hc. erewrite TwoCompl in Hc; auto.
  apply closureP; auto.
Qed.

Theorem interior_T1 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  A ∈ cT ↔ A = Interior A X cT.
Proof.
  intros * Hxe Ht Ha. pose proof SetminSubI A X as Hc. split; intros Hp.
  - eapply closed_C in Hp as Hp'; eauto.
    apply closure_T, (SetminEq _ _ X) in Hp'; auto.
    rewrite TwoCompl in Hp'; auto. rewrite interior_Ta; auto.
  - rewrite interior_Ta in Hp; auto. apply (SetminEq _ _ X) in Hp.
    rewrite TwoCompl in Hp; [|apply closureP]; auto.
    apply closure_T, closed_T in Hp; auto.
    rewrite TwoCompl in Hp; auto.
Qed.

Theorem interior_T2a : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Interior (Interior A X cT) X cT = Interior A X cT.
Proof.
  intros *Hxe Ht Ha. pose proof SetminSubI A X as Ha'.
  rewrite interior_Ta, interior_Ta, TwoCompl, closure_T2;
  auto. apply closureP; auto. apply interiorP.
Qed.

Theorem interior_T2b : ∀ A X cT,
  Ensemble X → Topology X cT → A ⊂ X → Interior A X cT ∈ cT.
Proof.
  intros * Hxe Ht Ha. eapply interior_T1; eauto.
  apply interiorP. symmetry; apply interior_T2a; auto.
Qed.

(* boundary *)
Definition Boundp x A X cT := Topology X cT ∧ A ⊂ X ∧ x ∈ X ∧
  ∀ U, Neigh x U X cT → U ∩ A ≠ ∅ ∧ U ∩ X - A ≠ ∅.
Definition Bound A X cT := \{λ x, Boundp x A X cT\}.

Fact boundP : ∀ A X cT, Bound A X cT ⊂ X.
Proof. intros * x Hx. AppC Hx; apply Hx. Qed.

Theorem bound_T : ∀ A X cT, Interior A X cT ∩ Bound A X cT = ∅.
Proof.
  intros. AppE; [exfalso|exfalso0]. inH. AppC H0. AppC H; apply H0 in H.
  andH. apply H1. AppE; [exfalso|exfalso0]. inH; smH; auto.
Qed.

Theorem Re1_ClInBo : ∀ A X cT, Topology X cT → A ⊂ X →
  Bound A X cT = Closure A X cT ∩ Closure (X - A) X cT.
Proof.
  intros * Ht Ha. pose proof SetminSubI A X as Ha'. AppE.
  - AppC H. red in H; andH. AppCG; Ens. andG; AppCG; Ens;
    [DC (x ∈ A); auto|DC (x ∈ X - A); auto]; right; apply derived_F1;
    red; andG; auto; intros; [apply H2 in H4 as [Hl _]|
    apply H2 in H4 as [_ Hl]]; intro; elim Hl; eapply InterEqEmI; Ens.
  - inH. AppCG; Ens. red; andG; auto. eapply closureP; eauto. intros.
    AppC H; AppC H0; orH; [smH; tauto|apply derived_F1 in H|
    apply derived_F1 in H0|].
    + andG. apply H in H1; intro; elim H1; apply InterEqEmE; auto.
      destruct H1 as [_ [_ [_ [V [_ [Hv Hvu]]]]]]. intro.
      assert (x ∈ U ∩ X - A); ens. rewrite H1 in H2; exfalso0.
    + andG; [|apply H0 in H1; intro; elim H1; apply InterEqEmE; auto].
      destruct H1 as [_ [_ [_ [V [_ [Hv Hvu]]]]]]. intro.
      assert (x ∈ U ∩ A); ens. rewrite H1 in H2; exfalso0.
    + apply derived_F1 in H; apply derived_F1 in H0. andG; [apply H in H1|
      apply H0 in H1]; intro; elim H1; apply InterEqEmE; auto.
Qed.

Theorem Re2_ClInBo : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closure A X cT ∩ Closure (X - A) X cT =
  X - (Interior A X cT ⋃ Interior (X - A) X cT).
Proof.
  intros * Hxe Ht Ha. rewrite interior_Tb, interior_Tb,
    TwoCompl, <- UnionCompl, CommuU;
  try apply interiorP; auto. apply SetminSubI.
Qed.

Theorem Re3_ClInBo : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  X - (Interior A X cT ⋃ Interior (X - A) X cT) = Bound (X - A) X cT.
Proof.
  intros * Hxe Ht Ha. rewrite Re1_ClInBo, TwoCompl,
    CommuI, Re2_ClInBo; auto. apply SetminSubI.
Qed.

Theorem Re4_ClInBo : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  X - (Interior (X - A) X cT) = Interior A X cT ⋃ Bound A X cT.
Proof.
  intros * Hxe Ht Ha. rewrite Re1_ClInBo, DistribuLU, CommuU, CommuU, IncU,
    (interior_Tb (X - A) _ _), TwoCompl, ComUn, IncI, interior_Tb; auto.
  apply closureP; auto. apply interiorP; auto. apply SetminSubI.
  apply (IncTran _ A). intros * z Hz. AppC Hz; destruct Hz; andH.
  destruct H2; andH; auto. intros * x Hx. AppCG; Ens.
Qed.

Theorem Re5_ClInBo : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  X - (Closure (X - A) X cT) = Closure A X cT - Bound A X cT.
Proof.
  intros * Hxe Ht Ha. rewrite Re1_ClInBo, TwoDMI, SetminId, CommuU, EmptyU,
   (SetminInter (Closure A X cT) _ X), <- interior_Ta, CommuI, IncI; auto.
  apply interior_F2. apply closureP; auto.
Qed.

Fact bound_F1 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Bound A X cT = Bound (X - A) X cT.
Proof. intros. rewrite Re1_ClInBo, Re2_ClInBo, Re3_ClInBo; auto. Qed.

Fact bound_F2 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closure A X cT = Interior A X cT ⋃ Bound A X cT.
Proof. intros. rewrite interior_Tb, Re4_ClInBo; auto. Qed.

Fact bound_F3 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Interior A X cT = Closure A X cT - Bound A X cT.
Proof. intros. rewrite interior_Ta, Re5_ClInBo; auto. Qed.

Corollary Re_bou_C1 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Closure A X cT = A ⋃ Bound A X cT.
Proof.
  intros. assert (A ⋃ Closure (X - A) X cT = X).
  { AppE. unH; auto. eapply closureP; revgoals; eauto. apply SetminSubI.
    DC (x ∈ A); ens. apply UnionI'. AppCG; Ens. left; ens. }
  rewrite Re1_ClInBo, DistribuLU, CommuU, CommuU, IncU, H2, IncI; auto.
  apply closureP; auto. apply closure_F1.
Qed.

Corollary Re_bou_C2 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Interior A X cT = A - Bound A X cT.
Proof.
  intros. pose proof (SetminSubI A X). assert (A ∩ X - Closure A X cT = ∅).
  { rewrite Re_bou_C1, TwoDMU; auto. AppE; [|exfalso0]. inH; smH; tauto. }
  erewrite Re1_ClInBo, SetminIE, InterCompl, DistribuLI, <- interior_Ta,
    H3, CommuU, EmptyU, CommuI, IncI; eauto; try apply closureP; auto;
  [|intros x Hx; inH; eapply closureP; eauto]. apply interior_F1.
Qed.

Corollary Re_bou_C3 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Bound (Interior A X cT) X cT ⊂ Bound A X cT.
Proof.
  intros. pose proof (SetminSubI A X). assert (Hai: Interior A X cT ⊂ A).
  apply interior_F1. rewrite Re1_ClInBo, Re1_ClInBo,
    <- (closure_T2 (X - A)); eens. intros x Hx; inH; inG.
  apply (closure_F2 (Interior A X cT)); auto.
  apply (closure_F2 (X - Interior A X cT)); auto. apply closureP; auto.
  rewrite Re_bou_C2, (SetminIE A (Bound A X cT) X), TwoDMI, TwoCompl,
    Re_bou_C1, bound_F1; auto; try apply boundP. intros y Hy; unH; ens.
Qed.

Corollary Re_bou_C4 : ∀ A X cT, Ensemble X → Topology X cT → A ⊂ X →
  Bound (Closure A X cT) X cT ⊂ Bound A X cT.
Proof.
  intros. rewrite Re1_ClInBo, Re1_ClInBo, closure_T2; auto;
  [|apply closureP; auto]. intros x Hx; inH. inG; ens.
  apply (closure_F2 (X - Closure A X cT) (X - A)); auto.
  apply SetminSubI. apply SetminSub2, closure_F1.
Qed.

(* subSpace *)
Definition RestFamEns cA Y := \{λ z, ∃ A, A ∈ cA ∧ z = A ∩ Y\}.
Notation "cA | Y" := (RestFamEns cA Y)(at level 30).

Lemma resFam : ∀ Y X cT, Ensemble X → Topology X cT → Y ⊂ X → Topology Y (cT|Y).
Proof.
  intros * Hxe Ht Hsub. split; andG.
  - intros z Hz. AppC Hz. destruct Hz as [A []].
    subst. assert (A ∩ Y ⊂ Y). intros x Hx; AppC Hx; tauto. eens.
  - AppCG; eens. exists X. andG. apply Ht. AppE; [|inH]; ens.
  - AppCG; ens. exists ∅. andG. apply Ht. AppE; [|inH]; exfalso0.
  - intros * Ha Hb. AppC Ha; AppC Hb.
    destruct Ha as [A' []], Hb as [B' []].
    subst. rewrite <- DisLII. AssE A'; AssE B'. AppCG.
    apply InterEns; eens. exists (A' ∩ B'). andG; auto. apply Ht; auto.
  - intros. assert (Hct: ∪cT1 ⊂ Y).
    { intros x Hx. eleU Hx. apply H in H1. AppC H1.
      destruct H1; andH. subst. inH; auto. } assert (Hp : ∀ A, A ∈ cT1 →
       ∃ A', [A,A'] ∈ \{\λ m n, n ∈ cT ∧ m = n ∩ Y\}\).
    { intros. AssE A. apply H in H0. AppC H0; destruct H0 as [A' []].
      AssE A'. exists A'. AppCG. ens. }
    assert (Hpe : Ensemble \{\λ m n, n ∈ cT ∧ m = n ∩ Y\}\).
    { assert (Hpe : \{\λ m n, n ∈ cT ∧ m = n ∩ Y\}\ ⊂ cP(X) × cT).
      { intros z Hz. PP Hz A B; andH. apply CProdI; auto.
        assert (A ⊂ X). subst; intros z Hz; inH; auto. ens. }
      eapply SubAxP; revgoals; eauto. apply CProdEns; ens.
      destruct Ht as [Ht _]. eens. }
    destruct (ChoAx1 _ _ Hpe Hp) as [f [Hf Hfp]].
    set (\{λ W, ∃ A, A ∈ cT1 ∧ W = f[A] ∩ Y\}) as cW.
    assert (Ht1: ∪cT1 = ∪cW).
    { AppE; eleU H0.
      - AppCG; andG; Ens. exists x0; andG; auto. AppCG; Ens.
        exists x0; andG; auto. apply Hfp in H1. AppC' H1; tauto.
      - AppC H1; destruct H1 as [A []]. apply Hfp in H1 as Ha.
        AppC' Ha; andH. AppCG; Ens. rewrite H2, <- H4 in H0; eauto. }
    set (\{λ V, ∃ A, A ∈ cT1 ∧ V = f[A]\}) as cV.
    assert (Ht2: ∪cW = (∪cV) ∩ Y).
    { AppE.
      - eleU H0. AppC H1; destruct H1 as [A []]. rewrite H2 in H0; inH.
        inG; auto. AppCG; Ens. exists f[A]; andG; auto. AppCG; eens.
      - inH. eleU H0. AppC H2; destruct H2 as [A []]. subst. AppCG; Ens.
        exists (f[A] ∩ Y). andG; ens. AppCG. apply InterEns; eens. }
    AppCG. eapply SubAxP; revgoals; eens. exists (∪ cV).
    rewrite Ht1, Ht2; andG; auto. apply Ht.
    intros A Ha. AppC Ha. destruct Ha as [B []]; andH.
    apply Hfp in H0. AppC' H0; andH. subst; auto.
Qed.

Definition SubTop Y X cT := Topology X cT ∧ Y ⊂ X.

Fact sTop_F1 : ∀ X Y cT, SubTop Y X cT →
  ∀ U, U ∈ cT|Y ↔ ∃ V, V ∈ cT ∧ U = V ∩ Y.
Proof.
  intros * [Ht Hs] *. split; intros. AppC H. destruct H as [V []].
  AssE V; AppCG. eapply SubAxP; eauto. intros x Hx; subst; inH; auto.
Qed.

Fact sTop_F2 : ∀ X Y Z cT,
  Ensemble X → SubTop Y X cT → SubTop Z Y (cT|Y) → SubTop Z X cT.
Proof. intros * Hxe [Hyt Hyx] [Hzt Hzy]. split; eens. Qed.

Theorem subTop_T1 : ∀ Y X cT, Ensemble X → SubTop Y X cT →
  Interior Y X cT ⋃ X - Closure Y X cT = X - Bound Y X cT.
Proof.
  intros * Hxe []. assert (Hix: Interior Y X cT ⊂ X). apply interiorP.
  rewrite bound_F2, UnionCompl, DistribuLU, ComUn, CommuI, IncI, IncU;
  auto. rewrite bound_F3; auto. apply SetminSub1, closureP; auto.
  intros x Hx; unH; ens. eapply SetminSubI; eauto. apply boundP.
Qed.

Theorem subTop_T2a : ∀ X Y cT, Ensemble X → SubTop Y X cT →
  ∀ y, y ∈ Y → NeighS y Y (cT|Y) = NeighS y X cT | Y.
Proof.
  intros * Hxe [Hxm Hs] * Hy. apply ExtAx; intro U; split; intros Hu.
  - AppCG; Ens. eapply neigh_F1 in Hu as [_ [_ [Hu [V [Hv [Hyv Hvu]]]]]];
    eens. AppC Hv. destruct Hv as [V1 [Hv1 Hvv]]. exists (V1 ⋃ U); andG;
    [|rewrite DistribuI, <- Hvv, IncI, IncU; auto].
    AppCG. apply UnionAx. Ens. eens. split; andG; auto.
    + intros x Hx. AppC Hx; orH; auto. apply Hxm in Hv1; pow Hv1.
    + exists V1. andG; auto. rewrite Hvv in Hyv; inH; auto. intros x Hx; AppCG; Ens.
  - AppCG; Ens. AppC Hu; destruct Hu as [A [Ha Hu]]. split; andG; auto.
    eapply resFam; eauto. subst; intros x Hx; inH; auto.
    eapply neigh_F1 in Ha as [_ [_ [Ha [V [Hv [Hyv Hva]]]]]]; eens.
    exists (V ∩ Y). rewrite Hu. andG; ens; [|intros x Hx; inH; ens].
    AppCG. apply InterEns; eens.
Qed.

Theorem subTop_T2b : ∀ X Y cT, Ensemble X → SubTop Y X cT →
  ∀ A, A ⊂ Y → Derived A Y (cT|Y) = Derived A X cT ∩ Y.
Proof.
  intros * Hxe [Hxm Hs] * Ha. AppE.
  - apply derived_F1 in H as [_ [_ [Hx Hxp]]]. inG; auto.
    apply derived_F1. split; andG; eens. intros. apply neigh_F1 in H; auto.
    assert (Neigh x (U ∩ Y) Y (cT | Y)).
    { apply neigh_F1; eens. erewrite subTop_T2a; eauto; [|split; auto].
      AppCG. eapply SubAxP; eauto. intros y Hy; inH; auto. }
    apply Hxp in H0. apply EmptyNE in H0 as [y]; inH.
    apply EmptyNE; exists y; ens.
  - inH. apply derived_F1 in H as [_ [_ [_ Hxp]]]. apply derived_F1.
    split; andG; auto. eapply resFam; eauto. intros V Hv.
    apply neigh_F1 in Hv; eens. erewrite subTop_T2a in Hv; eauto;
    [|split; auto]. AppC Hv; destruct Hv as [U [Hu Hvu]].
    apply neigh_F1, Hxp in Hu; auto. subst. rewrite AssocI, (CommuI Y),
      <- AssocI, IncI; auto. intros y Hy. inH; smH; auto.
Qed.

Theorem subTop_T2c : ∀ X Y cT, Ensemble X → SubTop Y X cT →
  ∀ A, A ⊂ Y → Closure A Y (cT|Y) = Closure A X cT ∩ Y.
Proof.
  intros * Hxe Hst * Ha. unfold Closure. erewrite subTop_T2b; eauto.
  rewrite <- (IncU A Y) at 2; auto. apply DistribuLU.
Qed.

(* connectedness *)
Definition Separation A B X cT :=
  A ⊂ X ∧ B ⊂ X ∧ (A ∩ Closure B X cT) ⋃ (B ∩ Closure A X cT) = ∅.

Fact sep_F1 : ∀ A B X cT, Separation A B X cT →
  A ∩ Closure B X cT = ∅ ∧ B ∩ Closure A X cT = ∅.
Proof. intros. apply two_union_Empty, H. Qed.

Fact sep_F2 : ∀ A B X cT, A ⊂ X → B ⊂ X → A ∩ Closure B X cT = ∅ →
  B ∩ Closure A X cT = ∅ → Separation A B X cT .
Proof. intros. split; andG; auto. apply two_union_Empty; auto. Qed.

Fact sep_F3 : ∀ A B X cT, Separation A B X cT →
  A ∩ B = ∅ ∧ A ∩ Derived B X cT = ∅.
Proof.
  intros. apply sep_F1 in H as [H _]. unfold Closure in H.
  rewrite DistribuLI in H. apply two_union_Empty in H; auto.
Qed.

Theorem separation_T : ∀ Y X cT, Ensemble X → SubTop Y X cT → ∀ A B,
  A ⊂ Y → B ⊂ Y → Separation A B Y (cT|Y) ↔ Separation A B X cT.
Proof.
  intros * Hxe Hst * Ha Hb.
  assert (Hp1: A ∩ Closure B Y (cT|Y) = A ∩ Closure B X cT).
  erewrite subTop_T2c, (CommuI _ Y), <- AssocI, (IncI A); eauto.
  assert (Hp2: B ∩ Closure A Y (cT|Y) = B ∩ Closure A X cT).
  erewrite subTop_T2c, (CommuI _ Y), <- AssocI, (IncI B); eauto.
  assert (Y ⊂ X). apply Hst. unfold Separation; rewrite Hp1, Hp2.
  split; intros; andH; andG; auto; eapply IncTran; eauto.
Qed.

Definition disConnected X cT :=
  ∃ A B, ⦿ A ∧ ⦿ B ∧ Separation A B X cT ∧ X = A ⋃ B.

Definition Connected X cT := ~ (disConnected X cT).

Theorem nConnect_Ta : ∀ X cT, Topology X cT → disConnected X cT →
  ∃ A B, ⦿ A ∧ ⦿ B ∧ Closed A X cT ∧ Closed B X cT ∧
  A ∩ B = ∅ ∧ A ⋃ B = X.
Proof.
  intros * Ht [A [B [Hae [Hbe [Hp1 Hp2]]]]]. assert (Heq: A ∩ B = ∅).
  { apply sep_F3 in Hp1; tauto. } pose proof Hp1.
  apply sep_F1 in H as [Hab Hba]. assert (A ⊂ X ∧ B ⊂ X).
  andG; apply Hp1. destruct H as [Has Hbs]. exists A, B. andG; auto;
  apply closure_T; auto; [rewrite <- (IncI (Closure A X cT) X)|
  rewrite <- (IncI (Closure B X cT) X)]; try apply closureP; auto;
  rewrite Hp2 at 2; rewrite CommuI, DistribuI; [rewrite Hba|
  rewrite Hab, CommuU]; rewrite EmptyU, IncI; auto; apply closure_F1.
Qed.

Theorem nConnect_Tb : ∀ X cT, Ensemble X → Topology X cT → (∃ A B,
  ⦿ A ∧ ⦿ B ∧ Closed A X cT ∧ Closed B X cT ∧ A ∩ B = ∅ ∧ A ⋃ B = X) →
  (∃ A B, ⦿ A ∧ ⦿ B ∧ A ∈ cT ∧ B ∈ cT ∧ A ∩ B = ∅ ∧ A ⋃ B = X).
Proof.
  intros * Hxe Ht [A [B [Hae [Hbe [Hba [Hbb [Hp1 Hp2]]]]]]].
  assert (A ⊂ X ∧ B ⊂ X). andG; [apply Hba|apply Hbb].
  destruct H as [Has Hbs]. apply closed_T in Hba; auto.
  apply closed_T in Hbb; auto. assert (A = X - B ∧ B = X - A).
  { andG; apply two_inter_Empty; auto; [rewrite CommuI|rewrite CommuU]; auto. }
  andH. exists A, B; andG; auto; [rewrite H|rewrite H0]; auto.
Qed.

Theorem nConnect_Tc : ∀ X cT, Ensemble X → Topology X cT →
  (∃ A B, ⦿ A ∧ ⦿ B ∧ A ∈ cT ∧ B ∈ cT ∧ A ∩ B = ∅ ∧ A ⋃ B = X) →
  (∃ C, ⦿ C ∧ C ⊊ X ∧ C ∈ cT ∧ Closed C X cT).
Proof.
  intros * Hxe Ht [A [B [Hae [Hbe [Hao [Hbo [Hp1 Hp2]]]]]]].
  apply Ht in Hao as Has; apply Ht in Hbo as Hbs. pow Has; pow Hbs.
  eapply two_inter_Empty in Hp1 as Hab; eauto. exists A; andG; auto. split; auto.
  { DC (A = X); auto. assert (B = ∅). rewrite (two_inter_Empty B A X); eauto;
    [|rewrite CommuI|rewrite CommuU]; auto. rewrite H; apply SetminId.
    destruct Hbe as [x]. subst B; exfalso0. }
  rewrite Hab; apply closed_C; auto.
Qed.

Theorem nConnect_Td : ∀ X cT, Ensemble X → Topology X cT →
  (∃ C, ⦿ C ∧ C ⊊ X ∧ C ∈ cT ∧ Closed C X cT) → disConnected X cT.
Proof.
  intros * Hxe Ht [A [Hae [[_ Hneq] [Hao Hac]]]]. set (B := X - A).
  assert (Has: A ⊂ X). apply Hac. assert (Hab: A ∩ B = ∅). apply ComIn.
  apply closed_T in Hac as Hbo; auto. eapply closed_C in Hao as Hbc; eauto.
  assert (Hbs: B ⊂ X). apply SetminSubI. exists A, B. andG; auto;
  [| |symmetry; apply ComUn; auto].
  { DC (⦿ B); auto. exfalso. apply EmptyEq in H. assert (A = X).
    { AppE; auto. DC (x ∈ A); auto. assert (x ∈ B).
      AppCG; Ens.  rewrite H in H2; exfalso0. } auto. } split; andG; auto;
  apply two_union_Empty; unfold Closure. repeat rewrite CommuU, IncU; andG; auto;
  [|apply Hac|apply Hbc]. rewrite CommuI; auto.
Qed.

Definition subConnect Y cT := Connected Y (cT|Y).
Definition disSubConnect Y cT := disConnected Y (cT|Y).

Theorem scon_T1 : ∀ Y Z X cT, Ensemble X → SubTop Z X cT →
  SubTop Y Z (cT|Z) → subConnect Y cT ↔ subConnect Y (cT|Z).
Proof.
  intros * Hxe Hzt Hyt. eapply sTop_F2 in Hyt as Hyx; eauto.
  assert (Z ⊂ X ∧ Y ⊂ Z). { andG. apply Hzt. apply Hyt. }
  destruct H as [Hzx Hyz]. assert (Ensemble Z ∧ Ensemble Y).
  { andG; eapply SubAxP; eauto. eapply IncTran; eauto. }
  destruct H as [Hze Hye]. split; intros Hsc;
  intros [A [B [Hae [Hbe [H Heq]]]]]; assert (A ⊂ Y ∧ B ⊂ Y);
  [subst; andG; intros x Hx; ens| |subst; andG; intros x Hx; ens|];
  destruct H0 as [Hay Hby]; apply Hsc; exists A, B; andG; auto;
  apply sep_F1 in H; [do 2 rewrite (subTop_T2c Z Y),
    (subTop_T2c X Z), AssocI, (CommuI Z Y), (IncI Y Z) in H; eens|
    do 2 rewrite (subTop_T2c X Y) in H; auto]; apply sep_F2; auto;
  try (rewrite (subTop_T2c X Y); tauto); rewrite (subTop_T2c Z Y),
    (subTop_T2c X Z), AssocI, (CommuI Z Y), (IncI Y Z); eens; tauto.
Qed.

Theorem scon_T2 : ∀ Y X cT, Ensemble X → SubTop Y X cT →
  disSubConnect Y cT ↔ ∃ A B, ⦿ A ∧ ⦿ B ∧ Separation A B X cT ∧ Y = A ⋃ B.
Proof.
  intros * Hxe Hst. split; intros [A [B [Hae [Hbe []]]]]; exists A, B; andG;
  auto; eapply separation_T; eauto; try apply H; subst; intros x Hx; ens.
Qed.

Theorem scon_T3 : ∀ Y X cT, Ensemble X → SubTop Y X cT →
  subConnect Y cT → ∀ A B, Separation A B X cT → Y ⊂ A ⋃ B → Y ⊂ A ∨ Y ⊂ B.
Proof.
  intros * Hxe Hyx Hsy * Hs Hsub. assert (Heq: A ∩ Y ⋃ B ∩ Y = Y).
  { rewrite <- DistribuI, CommuI; apply IncI; auto. }
  assert (Hd: A ∩ Y = ∅ ∨ B ∩ Y = ∅).
  { DC (A ∩ Y = ∅ ∨ B ∩ Y = ∅); auto. exfalso.
    apply not_or_and in H as [Ha Hb]. apply EmptyNE in Ha.
    apply EmptyNE in Hb. assert (disSubConnect Y cT).
    { apply (scon_T2 Y X cT); auto. exists (A∩Y), (B∩Y); andG; auto.
      split; andG; [intros x Hx|intros x Hx|]; inH; try apply Hyx; auto.
      assert ((A∩Y) ∩ Closure (B∩Y) X cT ⋃ (B∩Y) ∩ Closure (A∩Y) X cT ⊂
        (A∩Y) ∩ Closure B X cT ⋃ (B∩Y) ∩ Closure A X cT).
      { intros y Hy. unH; inH; [unG| apply UnionI']; inG; auto;
        eapply closure_F2; eauto; try apply Hs; intros z Hz; inH; auto. }
      AppE; [|exfalso0]. apply H in H0. destruct Hs as [_ [_ Hs]].
      rewrite (CommuI A Y), (CommuI B Y), AssocI, AssocI, <- DistribuLI, Hs,
        EmptyI in H0; auto. } apply Hsy, H. }
  orH; rewrite H in Heq; [rewrite CommuU in Heq|]; rewrite EmptyU in Heq;
  rewrite <- Heq; [right|left]; intros x Hx; inH; auto.
Qed.

Corollary scon_T3C1 : ∀ Y X cT, Ensemble X → SubTop Y X cT → subConnect Y cT →
  ∀ Z, SubTop Z X cT → Y ⊂ Z → Z ⊂ Closure Y X cT → subConnect Z cT.
Proof.
  intros * Hxe Hyx Hsy * HzX Hyz Hzc. DC (subConnect Z cT); auto.
  assert (Hzn: disSubConnect Z cT). unfold disSubConnect; apply NNPP, H.
  apply (scon_T2 Z X) in Hzn as [A [B [[x Ha] [[y Hb] [Hab Heq]]]]];
  auto. assert (A⊂X ∧ B⊂X). andG; apply Hab. destruct H0 as [Hax Hbx].
  assert (B = Z∩B ∧ A = Z∩A). { subst Z. andG; AppE; ens; inH; auto. }
  destruct H0 as [Hbz Haz]. clear H; pose proof Hab.
  apply sep_F1 in H as [Habc Hbac]. rewrite Heq in Hyz.
  apply (scon_T3 Y X) in Hab as [H|H]; auto;
  apply (closure_F2 Y _ X cT) in H; eauto.
  - assert (Z ⊂ Closure A X cT); eens. apply (InterRSub _ _ B) in H0.
    rewrite CommuI in Hbac. rewrite Hbac, <- Hbz in H0.
    assert (B = ∅). AppE; exfalso0. subst B; exfalso0.
  - assert (Z ⊂ Closure B X cT); eens. apply (InterRSub _ _ A) in H0.
    rewrite CommuI in Habc. rewrite Habc, <- Haz in H0.
    assert (A = ∅). AppE; exfalso0. subst A; exfalso0.
Qed.

Fact scon_T3C2 : ∀ A X cT, Ensemble X → SubTop A X cT →
  subConnect A cT → subConnect (Closure A X cT) cT.
Proof.
  intros * Hxe [Has Ht] Hac. assert (H: Closure A X cT ⊂ X).
  apply closureP; auto. assert (SubTop (Closure A X cT) X cT).
  split; andG; auto. eapply (scon_T3C1 A); eens. split; andG; auto.
  intros x Hx; unfold Closure; ens.
Qed.

Theorem scon_T4 : ∀ Y X cT, Ensemble X → SubTop Y X cT →
  ⦿ Interior Y X cT → Closure Y X cT ≠ X → Separation (Interior Y X cT)
  (X - (Closure Y X cT)) (X - (Bound Y X cT)) (cT|(X - (Bound Y X cT))).
Proof.
  intros * Hxe [Ht Hyx] Hye Hyn. assert (X - (Closure Y X cT) ⊂ X ∧
    X - (Closure Y X cT) ⊂ X - Bound Y X cT).
  { andG. apply SetminSubI. rewrite bound_F2; auto.
    apply SetminSub2; intros x Hx; ens. } destruct H as [Hbx Hby].
  assert (Interior Y X cT ⊂ X ∧ Interior Y X cT ⊂ X - Bound Y X cT).
  { andG. apply interiorP. rewrite bound_F3; auto. intros x Hx; smH; smG;
    auto. eapply closureP; revgoals; eauto. } destruct H as [Hax Hay].
  assert (Hst: SubTop (X - Bound Y X cT) X cT).
  { assert (X - Bound Y X cT ⊂ X). apply SetminSubI. split; andG; auto. }
  eapply separation_T, sep_F2; eauto.
  - rewrite (Re_bou_C1 (X - Closure Y X cT)), DistribuLI, <- bound_F1;
    try apply closureP; auto. apply two_union_Empty; andG.
    + rewrite bound_F2, TwoDMU; auto.
      AppE; [exfalso|exfalso0]. inH; smH; tauto.
    + rewrite bound_F3; auto. AppE; [exfalso|exfalso0].
      inH; smH. apply Re_bou_C4 in H0; auto.
  - rewrite (bound_F2 Y), (Re_bou_C1 (Interior Y X cT)), TwoDMU, DistribuLI;
    auto. apply two_union_Empty; andG; AppE; [exfalso|exfalso0|exfalso|exfalso0];
    inH; smH; auto. apply Re_bou_C3 in H0; auto.
Qed.

Corollary scon_T4C : ∀ Y X cT, Ensemble X → SubTop Y X cT →
  ⦿ Interior Y X cT → Closure Y X cT ≠ X → disSubConnect (X - (Bound Y X cT)) cT.
Proof.
  intros * Hxe [Ht Hyx] Hye Hyn. assert (Hbcx: X - Bound Y X cT ⊂ X).
  { intros x Hx; smH; auto. } assert (Hbe: Ensemble (X - Bound Y X cT)).
  { eapply SubAxP; eauto; intros x Hx; smH; auto. }
  assert (Hbt: Topology (X - Bound Y X cT) (cT | (X - Bound Y X cT))).
  { eapply resFam; revgoals; eauto. } apply nConnect_Td; auto.
  apply nConnect_Tc; eauto. assert (Hcx: Closure Y X cT ⊂ X).
  apply closureP; auto. assert (Hix: Interior Y X cT ⊂ X). apply interiorP.
  assert (Hbx: Bound Y X cT ⊂ X). apply boundP.
  exists (Interior Y X cT), (X - (Closure Y X cT)). andG; auto.
  - pose proof ProperSubE as [x []]. split; revgoals; eauto. exists x; ens.
  - assert (Interior Y X cT ∈ cT). apply interior_T2b; auto. AppCG; Ens.
    exists (Interior Y X cT); andG; auto. AppE; [|inH; auto]. inG; auto.
    smG; auto. rewrite bound_F3 in H0; auto. smH; auto.
  - assert (X - Closure Y X cT ∈ cT). apply closed_T, closure_F5; auto.
    AppCG; Ens. exists (X - Closure Y X cT). andG; auto. AppE; [|inH; auto].
    inG; auto. smH; smG; auto.
    rewrite interior_Tb, Re4_ClInBo in H1; auto. intro; ens.
  - AppE; [exfalso|exfalso0]. inH; smH. pose proof (interior_F2 Y X cT); auto.
  - apply subTop_T1; auto. split; auto.
Qed.


Require Export Ensembles.
Require Import EnsemblesImplicit.
Require Export Image.
Require Import ImageImplicit.
Require Export Finite_sets.
Require Export FunctionProperties.
Require Import DecidableDec.
Require Import ProofIrrelevance.
Require Import Description.

Inductive FiniteT : Type -> Prop :=
  | empty_finite: FiniteT False
  | add_finite: forall T:Type, FiniteT T -> FiniteT (option T)
  | bij_finite: forall (X Y:Type) (f:X->Y), FiniteT X ->
    invertible f -> FiniteT Y.

Lemma True_finite: FiniteT True.
Proof.
apply bij_finite with (option False)
  (fun _ => I).
constructor; constructor.
exists (True_rect None).
destruct x as [[]|].
remember (True_rect (@None False) I) as LHS.
destruct LHS as [[]|].
reflexivity.

exact (fun y:True => match y with
  | I => refl_equal I
  end).
Qed.

Lemma finite_dec_exists: forall (X:Type) (P:X->Prop),
  FiniteT X -> (forall x:X, {P x} + {~ P x}) ->
  { exists x:X, P x } + { forall x:X, ~ P x }.
Proof.
intros.
apply exclusive_dec.
red; intro.
destruct H0.
destruct H0.
contradiction (H1 x).

revert P X0.
induction H.
right.
destruct x.
intros.
case (IHFiniteT (fun x:T => P (Some x))
  (fun x:T => X0 (Some x))).
left.
destruct H0.
exists (Some x).
assumption.
intro.
case (X0 None).
left.
exists None.
assumption.
right.
destruct x.
apply H0.
assumption.
destruct H0.
intros.
case (IHFiniteT (fun x:X => P (f x))
  (fun x:X => X0 (f x))).
left.
destruct H2.
exists (f x).
assumption.
right.
intro.
rewrite <- H1 with x.
apply H2.
Qed.

Lemma finite_dec_forall: forall (X:Type) (P:X->Prop),
  FiniteT X -> (forall x:X, { P x } + { ~ P x }) ->
  { forall x:X, P x } + { exists x:X, ~ P x }.
Proof.
intros.
apply exclusive_dec.
intuition.
destruct H2.
contradiction (H1 x).

revert P X0.
induction H.
left.
destruct x.
intros.
case (IHFiniteT (fun x:T => P (Some x))
  (fun x:T => X0 (Some x))).
intro.
case (X0 None).
left.
destruct x.
apply H0.
assumption.
right.
exists None.
assumption.
right.
destruct H0.
exists (Some x).
assumption.

intros.
destruct H0.
case (IHFiniteT (fun x:X => P (f x))
  (fun x:X => X0 (f x))).
left.
intro y.
rewrite <- H1.
apply H2.
right.
destruct H2.
exists (f x).
assumption.
Qed.

Lemma finite_eq_dec: forall X:Type, FiniteT X ->
  forall x y:X, {x=y} + {x<>y}.
Proof.
intros.
apply decidable_dec.
induction H.
destruct x.
decide equality.

destruct H0.
case (IHFiniteT (g x) (g y)).
left.
rewrite <- H1.
rewrite <- H1 with x.
rewrite H2.
reflexivity.
right.
contradict H2.
rewrite H2.
reflexivity.
Qed.

Lemma finite_dep_choice: forall (A:Type) (B:forall x:A, Type)
  (R:forall x:A, B x->Prop),
  FiniteT A -> (forall x:A, exists y:B x, R x y) ->
  exists f:(forall x:A, B x), forall x:A, R x (f x).
Proof.
intros.
revert B R H0.
induction H.
intros.
exists (fun x:False => False_rect (B x) x).
destruct x.
intros.
pose proof (IHFiniteT (fun x:T => B (Some x))
  (fun x:T => R (Some x))
  (fun x:T => H0 (Some x))).
destruct H1.
pose proof (H0 None).
destruct H2.
exists (fun y:option T =>
  match y return (B y) with
  | Some y0 => x y0
  | None => x0
  end).
destruct x1.
apply H1.
assumption.

intros.
destruct H0.
pose proof (IHFiniteT (fun x:X => B (f x))
  (fun x:X => R (f x))
  (fun x:X => H1 (f x))).
destruct H3.
pose (f0 := fun y:Y => x (g y)).
pose (conv := fun (y:Y) (a:B (f (g y))) =>
  eq_rect (f (g y)) B a y (H2 y)).

exists (fun y:Y => conv y (x (g y))).
intro.
unfold conv; simpl.
generalize (H2 x0).
pattern x0 at 2 3 6.
rewrite <- H2.
intro.
rewrite <- eq_rect_eq.
apply H3.
Qed.

Lemma finite_choice : forall (A B:Type) (R:A->B->Prop),
  FiniteT A -> (forall x:A, exists y:B, R x y) ->
  exists f:A->B, forall x:A, R x (f x).
Proof.
intros.
apply finite_dep_choice.
assumption.
assumption.
Qed.

Lemma Finite_ens_type: forall {X:Type} (S:Ensemble X),
  Finite _ S -> FiniteT { x:X | In S x }.
Proof.
intros.
induction H.
apply bij_finite with False (False_rect _).
constructor.
assert (g:{x:X | In Empty_set x}->False).
intro.
destruct X0.
destruct i.
exists g.
destruct x.
destruct y.
destruct g.

assert (Included A (Add A x)).
auto with sets.
assert (In (Add A x) x).
auto with sets.
pose (g := fun (y: option {x:X | In A x}) =>
  match y return {x0:X | In (Add A x) x0} with
  | Some (exist y0 i) => exist (fun x2:X => In (Add A x) x2) y0 (H1 y0 i)
  | None => exist (fun x2:X => In (Add A x) x2) x H2
  end).
apply bij_finite with _ g.
apply add_finite.
assumption.

assert (h:forall x0:X, In (Add A x) x0 ->
  { In A x0 } + { x0 = x }).
intros; apply exclusive_dec.
intuition.
destruct H6; auto.
destruct H3.
left; assumption.
right; destruct H3; reflexivity.

pose (ginv := fun s:{x0:X | In (Add A x) x0} =>
  match s return option {x:X | In A x} with
  | exist x0 i => match (h x0 i) with
                  | left iA => Some (exist _ x0 iA)
                  | right _ => None
                  end
  end).
exists ginv.
intro; destruct x0.
destruct s.
simpl.
remember (h x0 (H1 x0 i)) as sum; destruct sum.
destruct (proof_irrelevance _ i i0).
reflexivity.
contradiction H0.
rewrite <- e; assumption.
simpl.
remember (h x H2) as sum; destruct sum.
contradiction H0.
reflexivity.

intro.
unfold ginv.
destruct y.
destruct (h x0 i).
simpl.
generalize (H1 x0 i0); intro.
destruct (proof_irrelevance _ i i1).
reflexivity.
simpl.
destruct e.
destruct (proof_irrelevance _ H2 i).
reflexivity.
Qed.

Lemma FiniteT_img: forall (X Y:Type) (f:X->Y),
  FiniteT X -> (forall y1 y2:Y, y1=y2 \/ y1<>y2) ->
  Finite _ (Im Full_set f).
Proof.
intros.
induction H.
assert (Im Full_set f = Empty_set).
apply Extensionality_Ensembles.
red; split.
red; intros.
destruct H.
destruct x.
auto with sets.
rewrite H.
constructor.

assert ({exists x:T, f (Some x) = f None} +
        {forall x:T, f (Some x) <> f None}).
apply finite_dec_exists.
assumption.
intro.
apply decidable_dec.
apply H0.
case H1.
intro.
pose (g := fun (x:T) => f (Some x)).
assert (Im Full_set f =
        Im Full_set g).
apply Extensionality_Ensembles.
red; split.
red; intros.
destruct H2.
destruct x.
exists t.
constructor.
assumption.
destruct e.
exists x.
constructor.
transitivity (f None).
assumption.
symmetry; assumption.
red; intros.
destruct H2.
exists (Some x).
constructor.
assumption.
rewrite H2.
apply IHFiniteT.

intros.
pose (g := fun x:T => f (Some x)).
assert (Im Full_set f =
  Add (Im Full_set g) (f None)).
apply Extensionality_Ensembles.
red; split.
red; intros.
destruct H2.
destruct x.
left.
exists t.
constructor.
assumption.
right.
auto with sets.
red; intros.
destruct H2.
destruct H2.
exists (Some x).
constructor.
assumption.
destruct H2.
exists None.
constructor.
reflexivity.
rewrite H2.
constructor.
apply IHFiniteT.
red; intro.
destruct H3.
contradiction (n x).
symmetry; assumption.

pose (g := fun (x:X) => f (f0 x)).
assert (Im Full_set f = Im Full_set g).
apply Extensionality_Ensembles.
red; split.
red; intros.
destruct H2.
destruct H1.
rewrite H3.
rewrite <- H4 with x.
exists (g0 x).
constructor.
unfold g.
reflexivity.
red; intros.
destruct H2.
exists (f0 x).
constructor.
assumption.

rewrite H2.
apply IHFiniteT.
Qed.

Lemma surj_finite: forall (X Y:Type) (f:X->Y),
  FiniteT X -> surjective f ->
  (forall y1 y2:Y, y1=y2 \/ y1<>y2) ->
  FiniteT Y.
Proof.
intros.
apply bij_finite with {y:Y | In (Im Full_set f) y}
  (@proj1_sig _ (fun y:Y => In (Im Full_set f) y)).
apply Finite_ens_type.
apply FiniteT_img.
assumption.
assumption.
assert (forall y:Y, In (Im Full_set f) y).
intro.
destruct (H0 y).
exists x; auto with sets.
constructor.

pose (proj1_sig_inv := fun y:Y =>
  exist (fun y0:Y => In (Im Full_set f) y0) y (H2 y)).
exists proj1_sig_inv.
destruct x.
simpl.
unfold proj1_sig_inv.
destruct (proof_irrelevance _ (H2 x) i); trivial.
intros; simpl; reflexivity.
Qed.

Lemma finite_subtype: forall (X:Type) (P:X->Prop),
  FiniteT X -> (forall x:X, P x \/ ~ P x) ->
  FiniteT {x:X | P x}.
Proof.
intros.
induction H.
apply bij_finite with False (False_rect _).
constructor.
exists (@proj1_sig _ _).
destruct x.
intro s; destruct s; destruct x.

destruct (H0 None).
pose (g := fun (x:option {x:T | P (Some x)}) =>
  match x return {x:option T | P x} with
  | Some (exist x0 i) => exist (fun x:option T => P x) (Some x0) i
  | None => exist (fun x:option T => P x) None H1
  end).
apply bij_finite with _ g.
apply add_finite.
apply IHFiniteT.
intro; apply H0.
pose (ginv := fun (s:{x0:option T | P x0}) =>
  match s return option {x:T | P (Some x)} with
  | exist (Some x0) i => Some (exist (fun y:T => P (Some y)) x0 i)
  | exist None _ => None
  end).
exists ginv.
destruct x as [[x0]|].
simpl.
reflexivity.
simpl.
reflexivity.
destruct y as [[x0|]].
simpl.
reflexivity.
simpl.
destruct (proof_irrelevance _ H1 p).
reflexivity.

pose (g := fun (x:{x:T | P (Some x)}) =>
  match x return {x:option T | P x} with
    | exist x0 i => exist (fun x:option T => P x) (Some x0) i
  end).
apply bij_finite with _ g.
apply IHFiniteT.
intro; apply H0.
pose (ginv := fun s:{x0:option T | P x0} =>
  match s return {x:T | P (Some x)} with
    | exist (Some x0) i => exist (fun x:T => P (Some x)) x0 i
    | exist None i => False_rect _ (H1 i)
  end).
exists ginv.
destruct x; simpl.
reflexivity.
destruct y as [[x0|]].
simpl.
reflexivity.
contradiction H1.

pose (g := fun (x:{x:X | P (f x)}) =>
  match x with
  | exist x0 i => exist (fun x:Y => P x) (f x0) i
  end).
apply bij_finite with _ g.
apply IHFiniteT.
intro; apply H0.
destruct H1.
assert (forall y:Y, P y -> P (f (g0 y))).
intros; rewrite H2; assumption.
pose (ginv := fun (y:{y:Y | P y}) =>
  match y with
  | exist y0 i => exist (fun x:X => P (f x)) (g0 y0) (H3 y0 i)
  end).
exists ginv.
destruct x; simpl.
generalize (H3 (f x) p).
rewrite H1.
intro; destruct (proof_irrelevance _ p p0).
reflexivity.

destruct y; simpl.
generalize (H3 x p).
rewrite H2.
intro; destruct (proof_irrelevance _ p p0).
reflexivity.
Qed.

Lemma inj_finite: forall (X Y:Type) (f:X->Y),
  FiniteT Y -> FunctionProperties.injective f ->
  (forall y:Y, (exists x:X, f x = y) \/
               (~ exists x:X, f x = y)) ->
  FiniteT X.
Proof.
intros.
assert (forall y:{y:Y | exists x:X, f x = y}, {x:X | f x = proj1_sig y}).
intro.
destruct y.
simpl.

apply constructive_definite_description.
destruct e.
exists x0.
red; split.
assumption.
intros.
apply H0.
transitivity x.
assumption.
symmetry; assumption.

pose (g := fun y:{y:Y | exists x:X, f x = y} =>
  proj1_sig (X0 y)).
apply bij_finite with _ g.
apply finite_subtype.
assumption.
assumption.

pose (ginv := fun (x:X) => exist (fun y:Y => exists x:X, f x = y)
  (f x) (ex_intro _ x (refl_equal _))).
exists ginv.
destruct x as [y [x e]].
unfold g; simpl.
match goal with |- context [X0 ?arg] => destruct (X0 arg) end.
simpl.
unfold ginv; simpl.
simpl in e0.
repeat match goal with |- context [ex_intro ?f ?x ?e] =>
  generalize (ex_intro f x e) end.
rewrite <- e0.
intros; destruct (proof_irrelevance _ e1 e2).
reflexivity.

intro; unfold ginv.
unfold g; simpl.
match goal with |- context [X0 ?arg] => destruct (X0 arg) end.
simpl.
simpl in e.
auto.
Qed.

Lemma finite_inj_surj: forall (X:Type) (f:X->X),
  FiniteT X -> injective f -> surjective f.
Proof.
intros.
induction H.
red.
destruct y.

remember (f None) as f0; destruct f0 as [a|].
assert (forall x:T, f (Some x) <> Some a).
unfold not; intros.
assert (Some x = None).
apply H0.
congruence.
discriminate H2.
pose (g := fun x:T => match f (Some x) with
  | Some y => y
  | None => a
end).
assert (surjective g).
apply IHFiniteT.
red; intros.
remember (f (Some x1)) as fx1; destruct fx1;
remember (f (Some x2)) as fx2; destruct fx2.
unfold g in H2.
rewrite <- Heqfx1 in H2; rewrite <- Heqfx2 in H2.
destruct H2; assert (f (Some x1) = f (Some x2)).
congruence.
apply H0 in H2.
injection H2; trivial.

unfold g in H2; rewrite <- Heqfx1 in H2; rewrite <- Heqfx2 in H2.
destruct H2.
contradiction (H1 x1).
symmetry; assumption.

unfold g in H2; rewrite <- Heqfx1 in H2; rewrite <- Heqfx2 in H2.
destruct H2.
contradiction (H1 x2).
symmetry; assumption.

assert (Some x1 = Some x2).
apply H0.
congruence.
injection H3; trivial.

red; intro.
destruct y.
case (finite_eq_dec _ H t a).
exists None.
congruence.
destruct (H2 t).
exists (Some x).
unfold g in H3.
destruct (f (Some x)).
congruence.
contradiction n.
symmetry; assumption.
destruct (H2 a).
exists (Some x).
unfold g in H3.
remember (f (Some x)) as fx; destruct fx.
destruct H3.
contradiction (H1 x).
symmetry; assumption.
reflexivity.

assert (forall x:T, { y:T | f (Some x) = Some y }).
intros.
remember (f (Some x)) as fx; destruct fx.
exists t; reflexivity.
assert (Some x = None).
apply H0.
congruence.
discriminate H1.
pose (g := fun x:T => proj1_sig (X x)).
assert (surjective g).
apply IHFiniteT.
red; intros.
unfold g in H1.
repeat destruct X in H1.
simpl in H1.
assert (Some x1 = Some x2).
apply H0.
congruence.
injection H2; trivial.

red; intro.
destruct y.
destruct (H1 t).
unfold g in H2; destruct X in H2.
simpl in H2.
exists (Some x).
congruence.
exists None.
symmetry; assumption.

destruct H1.

pose (f' := fun (x:X) => g (f (f0 x))).
assert (surjective f').
apply IHFiniteT.
red; intros.
unfold f' in H3.
assert (f (f0 x1) = f (f0 x2)).
congruence.
apply H0 in H4.
congruence.

red; intro.
destruct (H3 (g y)).
unfold f' in H4.
exists (f0 x).
congruence.
Qed.

Lemma finite_surj_inj: forall (X:Type) (f:X->X),
  FiniteT X -> surjective f -> FunctionProperties.injective f.
Proof.
intros.
assert (exists g:X->X, forall x:X, f (g x) = x).
apply finite_choice with (R:=fun (x y:X) => f y = x).
assumption.
assumption.
destruct H1 as [g].
assert (surjective g).
apply finite_inj_surj.
assumption.
red; intros.
rewrite <- H1 with x1.
rewrite <- H1 with x2.
rewrite H2; reflexivity.
red; intros.
destruct (H2 x1).
destruct (H2 x2).
rewrite <- H4 in H3.
rewrite <- H5 in H3.
repeat rewrite H1 in H3.
rewrite <- H4.
rewrite <- H5.
rewrite H3.
reflexivity.
Qed.

Lemma finite_sum: forall X Y:Type, FiniteT X -> FiniteT Y ->
  FiniteT (X+Y).
Proof.
intros.
induction H0.
apply bij_finite with _ inl.
assumption.
pose (g := fun (x:X+False) => match x with
  | inl x => x
  | inr f => False_rect X f
end).
exists g.
intro; simpl.
reflexivity.
destruct y.
simpl.
reflexivity.
destruct f.

pose (g := fun (x:option (X+T)) => match x with
  | Some (inl x) => inl _ x
  | Some (inr t) => inr _ (Some t)
  | None => inr _ None
  end).
apply bij_finite with _ g.
apply add_finite.
assumption.
pose (ginv := fun (x:X + option T) => match x with
  | inl x => Some (inl _ x)
  | inr (Some t) => Some (inr _ t)
  | inr None => None
  end).
exists ginv.
destruct x as [[x|t]|]; trivial.
destruct y as [x|[t|]]; trivial.

pose (g := fun (x:X+X0) => match x with
  | inl x0 => inl _ x0
  | inr x0 => inr _ (f x0)
  end).
destruct H1.
pose (ginv := fun (x:X+Y) => match x with
  | inl x0 => inl _ x0
  | inr y0 => inr _ (g0 y0)
  end).
apply bij_finite with _ g.
assumption.
exists ginv.
destruct x as [x0|x0]; trivial.
simpl.
rewrite H1; reflexivity.
destruct y as [x|y0]; trivial.
simpl.
rewrite H2; reflexivity.
Qed.

Lemma finite_prod: forall (X Y:Type), FiniteT X -> FiniteT Y ->
  FiniteT (X*Y).
Proof.
intros.
induction H0.
apply bij_finite with _ (False_rect _).
constructor.
exists (@snd X False).
destruct x.
destruct y.
destruct f.

pose (g := fun (x:X*T + X) => match x with
  | inl (pair x0 t) => pair x0 (Some t)
  | inr x0 => pair x0 None
  end).
pose (ginv := fun (x:X * option T) => match x with
  | (x0, Some t) => inl _ (x0, t)
  | (x0, None) => inr _ x0
  end).
apply bij_finite with _ g.
apply finite_sum.
assumption.
assumption.
exists ginv.
destruct x as [[x0 t]|x0]; trivial.
destruct y as [x0 [t|]]; trivial.

pose (g := fun (y:X*X0) => match y with
  | pair x x0 => pair x (f x0)
  end).
destruct H1.
pose (ginv := fun (y:X*Y) => let (x,y0) := y in
  (x, g0 y0)).
apply bij_finite with _ g.
assumption.
exists ginv.
destruct x as [x x0]; unfold ginv, g; try rewrite H1; trivial.
destruct y as [x y]; unfold ginv, g; try rewrite H2; trivial.
Qed.

Require Import FunctionalExtensionality.

Lemma finite_exp: forall X Y:Type, FiniteT X -> FiniteT Y ->
  FiniteT (X->Y).
Proof.
intros.
induction H.
pose (g := fun (x:True) (f:False) => False_rect Y f).
pose (ginv := fun (_:False->Y) => I).
apply bij_finite with _ g.
apply True_finite.
exists ginv.
destruct x as [].
trivial.
intro; extensionality f.
destruct f.

pose (g := fun (p:(T->Y)*Y) (x:option T) =>
  let (f,y0) := p in
  match x with
  | Some x0 => f x0
  | None => y0
  end).
pose (ginv := fun (f:option T->Y) =>
  (fun x:T => f (Some x), f None)).
apply bij_finite with _ g.
apply finite_prod.
assumption.
assumption.
exists ginv.
destruct x as [f y0]; try extensionality t;
try destruct t as [t0|]; trivial.
intro.
extensionality t; destruct t as [t0|]; trivial.

destruct H1.
pose (g0 := fun (h:X->Y) (y:Y0) => h (g y)).
apply bij_finite with _ g0.
assumption.
pose (g0inv := fun (h:Y0->Y) (x:X) => h (f x)).
exists g0inv.
intro.
extensionality x0; unfold g0; unfold g0inv; simpl.
rewrite H1; reflexivity.
intro.
extensionality y0; unfold g0; unfold g0inv; simpl.
rewrite H2; reflexivity.
Qed.

Lemma FiniteT_has_nat_cardinal: forall X:Type, FiniteT X ->
  exists! n:nat, cardinal _ (@Full_set X) n.
Proof.
intros.
apply -> unique_existence; split.
apply finite_cardinal.
pose (idX := fun x:X => x).
assert (Im Full_set idX = Full_set).
apply Extensionality_Ensembles.
red; split.
red; intros; constructor.
red; intros.
exists x.
constructor.
trivial.

rewrite <- H0.
apply FiniteT_img with (f:=fun x:X => x).
assumption.
intros.
case (finite_eq_dec X H y1 y2); tauto.

red; intros.
apply cardinal_unicity with X Full_set; trivial.
Qed.

Definition FiniteT_nat_cardinal (X:Type) (H:FiniteT X) : nat :=
  proj1_sig (constructive_definite_description _
              (FiniteT_has_nat_cardinal X H)).
Lemma FiniteT_nat_cardinal_def: forall (X:Type) (H:FiniteT X),
  cardinal _ (@Full_set X) (FiniteT_nat_cardinal X H).
Proof.
intros; unfold FiniteT_nat_cardinal.
destruct constructive_definite_description.
assumption.
Qed.
Lemma FiniteT_nat_cardinal_cond: forall (X:Type) (H:FiniteT X)
  (n:nat),
  cardinal _ (@Full_set X) n ->
  FiniteT_nat_cardinal X H = n.
Proof.
intros.
pose proof (FiniteT_has_nat_cardinal X H).
destruct H1.
red in H1.
destruct H1.
transitivity x.
symmetry; apply H2.
apply FiniteT_nat_cardinal_def.
apply H2; trivial.
Qed.

Lemma FiniteT_nat_cardinal_False:
  FiniteT_nat_cardinal False empty_finite = 0.
Proof.
apply FiniteT_nat_cardinal_cond.
assert (@Full_set False = @Empty_set False).
apply Extensionality_Ensembles; red; split; auto with sets.
red; intros.
destruct x.
rewrite H.
constructor.
Qed.

Lemma injection_preserves_cardinal: forall (X Y:Type)
  (f:X->Y) (n:nat) (S:Ensemble X), cardinal _ S n ->
  injective f -> cardinal _ (Im S f) n.
Proof.
intros.
induction H.
assert (Im Empty_set f = Empty_set).
apply Extensionality_Ensembles; split; auto with sets.
red; intros.
destruct H.
destruct H.
rewrite H; constructor.
assert (Im (Add A x) f = Add (Im A f) (f x)).
apply Extensionality_Ensembles; split.
red; intros.
destruct H2.
symmetry in H3; destruct H3.
destruct H2.
left; exists x0; auto with sets.
destruct H2; right; auto with sets.
red; intros.
destruct H2.
destruct H2.
exists x0.
left; auto with sets.
assumption.
destruct H2.
exists x; trivial; right; auto with sets.
rewrite H2.
constructor; trivial.
red; intro H3; inversion H3.
apply H0 in H5; destruct H5.
contradiction H1.
Qed.

Lemma FiniteT_nat_cardinal_option:
  forall (X:Type) (H:FiniteT X),
  FiniteT_nat_cardinal (option X) (add_finite X H) =
  S (FiniteT_nat_cardinal X H).
Proof.
intros.
apply FiniteT_nat_cardinal_cond.
assert (Full_set =
        Add (Im Full_set (@Some X)) None).
apply Extensionality_Ensembles; split.
red; intros.
destruct x.
left; exists x; constructor.
right; constructor.
red; intros; constructor.
rewrite H0.
constructor.
apply injection_preserves_cardinal.
apply FiniteT_nat_cardinal_def.
red; intros x1 x2 Heq; injection Heq; trivial.
red; intro.
inversion H1.
discriminate H3.
Qed.

Lemma FiniteT_nat_cardinal_bijection:
  forall (X Y:Type) (H:FiniteT X) (g:X->Y) (Hinv:invertible g),
    FiniteT_nat_cardinal Y (bij_finite X Y g H Hinv) =
    FiniteT_nat_cardinal X H.
Proof.
intros.
apply FiniteT_nat_cardinal_cond.
apply invertible_impl_bijective in Hinv.
destruct Hinv as [g_inj g_surj].
assert (Full_set = Im Full_set g).
apply Extensionality_Ensembles; split; red; intros;
  try constructor.
destruct (g_surj x).
exists x0; try constructor; auto.
rewrite H0; apply injection_preserves_cardinal; trivial.
apply FiniteT_nat_cardinal_def.
Qed.

Lemma unique_FiniteT_nat_cardinal:
  exists! f: (forall (X:Type), FiniteT X -> nat),
  f False empty_finite = 0 /\
  (forall (X:Type) (H:FiniteT X),
     f (option X) (add_finite X H) = S (f X H)) /\
  (forall (X Y:Type) (H:FiniteT X) (g:X->Y) (Hinv:invertible g),
     f Y (bij_finite X Y g H Hinv) = f X H).
Proof.
match goal with |- @ex ?T (@unique ?T ?f) =>
  apply -> (@unique_existence T f) end.
split.
exists FiniteT_nat_cardinal.
repeat split.
exact FiniteT_nat_cardinal_False.
exact FiniteT_nat_cardinal_option.
exact FiniteT_nat_cardinal_bijection.
red; intros f g Hf Hg.
destruct Hf as [HFalse_f [Hoption_f Hbijection_f]].
destruct Hg as [HFalse_g [Hoption_g Hbijection_g]].
extensionality X; extensionality HFinite.
generalize HFinite.
induction HFinite.
intro.
destruct (proof_irrelevance _ empty_finite HFinite).
congruence.
intro.
destruct (proof_irrelevance _ (add_finite T HFinite) HFinite0).
congruence.
intro.
destruct (proof_irrelevance _ (bij_finite _ _ f0 HFinite H) HFinite0).
congruence.
Qed.


Require Import List.
Import ListNotations.

Require Import Logic.Class.Eq.

Require Import Logic.List.In.
Require Import Logic.List.Include.
Require Import Logic.List.InjectiveOn.
Require Import Logic.List.Difference.

Fixpoint remove (v:Type) (e:Eq v) (x:v) (xs:list v) : list v :=
    match xs with
    | []            => []
    | (cons y ys)   =>
        match (eqDec x y) with
        | left _    => remove v e x ys
        | right _   => cons y (remove v e x ys)
        end
    end.

Arguments remove {v} {e}.

Lemma remove_still : forall (v:Type) (e:Eq v) (x y:v) (xs:list v),
    x <> y -> y :: xs -> y :: (remove x xs).
Proof.
    intros v e x y. induction xs as [|a xs IH].
    - intros _ H. inversion H.
    - intros Exy H. simpl. destruct (eqDec x a) eqn:Exa.
        + apply IH.
            { assumption. }
            { destruct H as [H1|H2].
                { exfalso. apply Exy. rewrite <- H1. assumption. }
                { assumption. }
            }
        + destruct H.
            { left. assumption. }
            { right. apply IH; assumption. }
Qed.

Lemma remove_mon : forall (v:Type) (e:Eq v) (x:v) (xs ys:list v),
    xs <= ys -> (remove x xs) <= (remove x ys).
Proof.
    intros v e x. induction xs as [|a xs IH]; simpl; intros ys H.
    - intros y Hy. inversion Hy.
    - destruct (eqDec x a) eqn:E.
        + apply IH. intros y Hy. apply H. right. assumption.
        + intros y Hy. destruct (eqDec y a) as [H1|H2].
            { apply remove_still.
                { rewrite H1. assumption. }
                { apply H. left. symmetry. assumption. }
            }
            { apply IH.
                { intros z Hz. apply H. right. assumption. }
                { destruct Hy as [G1|G2].
                    { exfalso. apply H2. symmetry. assumption. }
                    { assumption. }
                 }
            }
Qed.

Lemma remove_map_incl:forall(v w:Type)(e:Eq v)(e':Eq w)(f:v -> w)(x:v)(xs:list v),
    remove (f x) (map f xs) <= map f (remove x xs).
Proof.
    intros v w e e' f x xs. induction xs as [|a xs IH]; simpl.
    - apply incl_refl.
    - destruct (eqDec x a) as [P|P].
        + destruct (eqDec (f x) (f a)) as [Q|Q].
            { assumption. }
            { exfalso. apply Q. rewrite P. reflexivity. }
        + destruct (eqDec (f x) (f a)) as [Q|Q].
            { apply incl_tl. assumption. }
            { simpl. intros y Hy. destruct Hy.
                { left. assumption. }
                { right. apply IH. assumption. }}
Qed.

Lemma remove_x_gone: forall (v:Type) (e:Eq v) (x:v) (xs:list v),
    ~ x :: remove x xs.
Proof.
    intros v e x. induction xs as [|a xs IH]; simpl.
    - intros H. assumption.
    - destruct (eqDec x a) as [Hp|Hp].
        + subst. assumption.
        + intros [H'|H'].
            { subst. apply Hp. reflexivity. }
            { apply IH. assumption. }
Qed.

Lemma remove_x_not_in : forall (v:Type) (e:Eq v) (x:v) (xs:list v),
    ~ x :: xs -> remove x xs = xs.
Proof.
    intros v e x xs. induction xs as [|a xs IH]; simpl; intros H.
    - reflexivity.
    - destruct (eqDec x a) as [Hx|Hx].
        + exfalso. apply H. left. symmetry. assumption.
        + rewrite IH.
            { reflexivity. }
            { intros H'. apply H. right. assumption. }
Qed.

Lemma remove_map : forall (v w:Type)(e:Eq v)(e':Eq w)(f:v -> w)(x:v)(xs:list v),
    (forall (y:v), x <> y -> y :: xs -> f x <> f y) ->
    remove (f x) (map f xs) = map f (remove x xs).
Proof.
   intros v w e e' f x xs H.
   induction xs as [|a xs IH]; simpl.
   - reflexivity.
   - destruct (eqDec (f x) (f a)) as [Hq|Hq].
        + subst. destruct (eqDec x a) as [Hp|Hp].
            { subst. apply IH. intros y H1 H2. apply H.
                { assumption. }
                { right. assumption. }}
            { exfalso. apply H with a.
                { assumption. }
                { left. reflexivity. }
                { assumption. }}
        + destruct (eqDec x a) as [Hp|Hp].
            { subst. exfalso. apply Hq. reflexivity. }
            { simpl. rewrite IH.
                { reflexivity. }
                { intros y H1 H2. apply H.
                    { assumption. }
                    { right. assumption. }}}
Qed.

Lemma remove_inj : forall (v w:Type)(e:Eq v)(e':Eq w)(f:v -> w)(x:v)(xs:list v),
    x :: xs ->
    injective_on xs f ->
    remove (f x) (map f xs) = map f (remove x xs).
Proof.
    intros v w e e' f x xs H1 H2. apply remove_map.
    intros y H3 H4 H5. apply H3, H2; assumption.
Qed.

Lemma remove_inj2 : forall (v w:Type)(e:Eq v)(e':Eq w)(f:v -> w)(x:v)(xs:list v),
    injective_on (x :: xs) f ->
    remove (f x) (map f xs) = map f (remove x xs).
Proof.
    intros v w e e' f x xs H1. apply remove_map.
    intros y H2 H3 H4. apply H2, H1.
    - left. reflexivity.
    - right. assumption.
    - assumption.
Qed.

Lemma remove_incl : forall (v:Type) (e:Eq v) (x:v) (xs:list v),
    remove x xs <= xs.
Proof.
    intros v e x xs. induction xs as [|a xs IH]; simpl.
    - apply incl_refl.
    - destruct (eqDec x a) as [H|H].
        + apply incl_tl. assumption.
        + apply incl_cons_compat. assumption.
Qed.

Lemma remove_charac : forall (v:Type) (e:Eq v) (x:v) (xs:list v),
    forall (z:v), z :: remove x xs <-> z :: xs /\ x <> z.
Proof.
    intros v e x. induction xs as [|y ys IH]; simpl; intros z.
    - split; intros H.
        + exfalso. assumption.
        + destruct H as [H _]. assumption.
    - split; intros H; destruct (eqDec x y) as [E|E].
        + subst. apply IH in H. split.
            { right. destruct H as [H _]. assumption. }
            { destruct H as [_ H]. assumption. }
        + split; destruct H as [H|H].
            { left. assumption. }
            { apply IH in H. destruct H as [H1 H2]. right. assumption. }
            { subst. assumption. }
            { apply IH in H. destruct H as [_ H]. assumption. }
        + subst. destruct H as [H1 H2]. destruct H1 as [H1|H1].
            { exfalso. apply H2. assumption. }
            { apply IH. split; assumption. }
        + simpl. destruct H as [H1 H2]. destruct H1 as [H1|H1].
            { subst. left. reflexivity. }
            { right. apply IH. split; assumption. }
Qed.

Lemma remove_diff : forall (v:Type) (e:Eq v) (x:v) (xs:list v),
    remove x xs = xs \\ [x].
Proof.
    intros v e x. induction xs as [|y ys IH].
    - reflexivity.
    - simpl. destruct (eqDec x y) as [H|H].
        + apply IH.
        + rewrite IH. reflexivity.
Qed.


(* scratch.v  *)

Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq.

Inductive e : Type :=
  | enil : e
  | eC : e -> e
  | eP : e ->e.

Inductive evol : e -> e -> Prop :=
 | er : forall j k, j = k ->  evol j k
 | ep : forall j k, evol j k -> evol j (eP k).

Lemma e_refl: forall e, evol e e.
Proof. by move=> H //; constructor. Qed.

Lemma evol_eP i j: evol (eP i) j -> evol i j.
Proof.
move=> H2; elim: j H2=>[|e IH| e IH]H2; inversion H2; try (by discriminate H).
+ by rewrite -H; apply: ep; constructor.
by apply: ep; apply: IH.
Qed.

Lemma e_trans: forall i j k, evol i j -> evol j k -> evol i k.
Proof.
move=> i; elim=>//=[||]k/=. case=>//.

move=>i j k H1; elim=>//. IH H1 H2.
apply: H1.

elim=> i1 j1; first by move=>->.
 [|H IH H2].
 H1 H2.
elim: H1.


Require Import init.

Require Export mult_ring.

(** Alright, I lied, these are just records and not categories.  I'll make
categories later (maybe).
*)

Record RngObj := make_rng {
    rng_U : Type;
    rng_plus : Plus rng_U;
    rng_zero : Zero rng_U;
    rng_neg : Neg rng_U;
    rng_mult : Mult rng_U;
    rng_plus_assoc : @PlusAssoc rng_U rng_plus;
    rng_plus_comm : @PlusComm rng_U rng_plus;
    rng_plus_lid : @PlusLid rng_U rng_plus rng_zero;
    rng_plus_linv : @PlusLinv rng_U rng_plus rng_zero rng_neg;
    rng_mult_assoc : @MultAssoc rng_U rng_mult;
    rng_ldist : @Ldist rng_U rng_plus rng_mult;
    rng_rdist : @Rdist rng_U rng_plus rng_mult;
}.

Record RingObj := make_ring {
    ring_rng : RngObj;
    ring_one : One (rng_U ring_rng);
    ring_mult_lid : @MultLid (rng_U ring_rng) (rng_mult ring_rng) ring_one;
    ring_mult_rid : @MultRid (rng_U ring_rng) (rng_mult ring_rng) ring_one;
}.
Definition ring_U R := rng_U (ring_rng R).
Definition ring_plus R := rng_plus (ring_rng R).
Definition ring_zero R := rng_zero (ring_rng R).
Definition ring_neg R := rng_neg (ring_rng R).
Definition ring_mult R := rng_mult (ring_rng R).
Definition ring_plus_assoc R := rng_plus_assoc (ring_rng R).
Definition ring_plus_comm R := rng_plus_comm (ring_rng R).
Definition ring_plus_lid R := rng_plus_lid (ring_rng R).
Definition ring_plus_linv R := rng_plus_linv (ring_rng R).
Definition ring_mult_assoc R := rng_mult_assoc (ring_rng R).
Definition ring_ldist R := rng_ldist (ring_rng R).
Definition ring_rdist R := rng_rdist (ring_rng R).

Record CRingObj := make_cring {
    cring_ring : RingObj;
    cring_mult_comm : @MultComm (ring_U cring_ring) (ring_mult cring_ring);
}.
Definition cring_U R := ring_U (cring_ring R).
Definition cring_plus R := ring_plus (cring_ring R).
Definition cring_zero R := ring_zero (cring_ring R).
Definition cring_neg R := ring_neg (cring_ring R).
Definition cring_mult R := ring_mult (cring_ring R).
Definition cring_plus_assoc R := ring_plus_assoc (cring_ring R).
Definition cring_plus_comm R := ring_plus_comm (cring_ring R).
Definition cring_plus_lid R := ring_plus_lid (cring_ring R).
Definition cring_plus_linv R := ring_plus_linv (cring_ring R).
Definition cring_mult_assoc R := ring_mult_assoc (cring_ring R).
Definition cring_ldist R := ring_ldist (cring_ring R).
Definition cring_one R := ring_one (cring_ring R).
Definition cring_mult_lid R := ring_mult_lid (cring_ring R).

Global Existing Instances cring_plus cring_zero cring_neg cring_mult
    cring_plus_assoc cring_plus_comm cring_plus_lid cring_plus_linv
    cring_mult_assoc cring_ldist cring_one cring_mult_lid cring_mult_comm.