/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
-/
import topology.subset_properties

/-!
# Connected subsets of topological spaces

In this file we define connected subsets of a topological spaces and various other properties and
classes related to connectivity.

## Main definitions

We define the following properties for sets in a topological space:

* `is_connected`: a nonempty set that has no non-trivial open partition.
  See also the section below in the module doc.
* `connected_component` is the connected component of an element in the space.
* `is_totally_disconnected`: all of its connected components are singletons.
* `is_totally_separated`: any two points can be separated by two disjoint opens that cover the set.

For each of these definitions, we also have a class stating that the whole space
satisfies that property:
`connected_space`, `totally_disconnected_space`, `totally_separated_space`.

## On the definition of connected sets/spaces

In informal mathematics, connected spaces are assumed to be nonempty.
We formalise the predicate without that assumption as `is_preconnected`.
In other words, the only difference is whether the empty space counts as connected.
There are good reasons to consider the empty space to be “too simple to be simple”
See also https://ncatlab.org/nlab/show/too+simple+to+be+simple,
and in particular
https://ncatlab.org/nlab/show/too+simple+to+be+simple#relationship_to_biased_definitions.
-/

open set function topological_space
open_locale classical topological_space

universes u v
variables {α : Type u} {β : Type v} {ι : Type*} {π : ι → Type*} [topological_space α]
  {s t u v : set α}

section preconnected

/-- A preconnected set is one where there is no non-trivial open partition. -/
def is_preconnected (s : set α) : Prop :=
∀ (u v : set α), is_open u → is_open v → s ⊆ u ∪ v →
  (s ∩ u).nonempty → (s ∩ v).nonempty → (s ∩ (u ∩ v)).nonempty

/-- A connected set is one that is nonempty and where there is no non-trivial open partition. -/
def is_connected (s : set α) : Prop :=
s.nonempty ∧ is_preconnected s

lemma is_connected.nonempty {s : set α} (h : is_connected s) :
  s.nonempty := h.1

lemma is_connected.is_preconnected {s : set α} (h : is_connected s) :
  is_preconnected s := h.2

theorem is_preirreducible.is_preconnected {s : set α} (H : is_preirreducible s) :
  is_preconnected s :=
λ _ _ hu hv _, H _ _ hu hv

theorem is_irreducible.is_connected {s : set α} (H : is_irreducible s) : is_connected s :=
⟨H.nonempty, H.is_preirreducible.is_preconnected⟩

theorem is_preconnected_empty : is_preconnected (∅ : set α) :=
is_preirreducible_empty.is_preconnected

theorem is_connected_singleton {x} : is_connected ({x} : set α) :=
is_irreducible_singleton.is_connected

theorem is_preconnected_singleton {x} : is_preconnected ({x} : set α) :=
is_connected_singleton.is_preconnected

theorem set.subsingleton.is_preconnected {s : set α} (hs : s.subsingleton) :
  is_preconnected s :=
hs.induction_on is_preconnected_empty (λ x, is_preconnected_singleton)

/-- If any point of a set is joined to a fixed point by a preconnected subset,
then the original set is preconnected as well. -/
theorem is_preconnected_of_forall {s : set α} (x : α)
  (H : ∀ y ∈ s, ∃ t ⊆ s, x ∈ t ∧ y ∈ t ∧ is_preconnected t) :
  is_preconnected s :=
begin
  rintros u v hu hv hs ⟨z, zs, zu⟩ ⟨y, ys, yv⟩,
  have xs : x ∈ s, by { rcases H y ys with ⟨t, ts, xt, yt, ht⟩, exact ts xt },
  wlog xu : x ∈ u := hs xs using [u v y z, v u z y],
  rcases H y ys with ⟨t, ts, xt, yt, ht⟩,
  have := ht u v hu hv(subset.trans ts hs) ⟨x, xt, xu⟩ ⟨y, yt, yv⟩,
  exact this.imp (λ z hz, ⟨ts hz.1, hz.2⟩)
end

/-- If any two points of a set are contained in a preconnected subset,
then the original set is preconnected as well. -/
theorem is_preconnected_of_forall_pair {s : set α}
  (H : ∀ x y ∈ s, ∃ t ⊆ s, x ∈ t ∧ y ∈ t ∧ is_preconnected t) :
  is_preconnected s :=
begin
  rcases eq_empty_or_nonempty s with (rfl|⟨x, hx⟩),
  exacts [is_preconnected_empty, is_preconnected_of_forall x (λ y, H x y hx)],
end

/-- A union of a family of preconnected sets with a common point is preconnected as well. -/
theorem is_preconnected_sUnion (x : α) (c : set (set α)) (H1 : ∀ s ∈ c, x ∈ s)
  (H2 : ∀ s ∈ c, is_preconnected s) : is_preconnected (⋃₀ c) :=
begin
  apply is_preconnected_of_forall x,
  rintros y ⟨s, sc, ys⟩,
  exact ⟨s, subset_sUnion_of_mem sc, H1 s sc, ys, H2 s sc⟩
end

theorem is_preconnected_Union {ι : Sort*} {s : ι → set α} (h₁ : (⋂ i, s i).nonempty)
  (h₂ : ∀ i, is_preconnected (s i)) :
  is_preconnected (⋃ i, s i) :=
exists.elim h₁ $ λ f hf, is_preconnected_sUnion f _ hf (forall_range_iff.2 h₂)

theorem is_preconnected.union (x : α) {s t : set α} (H1 : x ∈ s) (H2 : x ∈ t)
  (H3 : is_preconnected s) (H4 : is_preconnected t) : is_preconnected (s ∪ t) :=
sUnion_pair s t ▸ is_preconnected_sUnion x {s, t}
  (by rintro r (rfl | rfl | h); assumption)
  (by rintro r (rfl | rfl | h); assumption)

theorem is_connected.union {s t : set α} (H : (s ∩ t).nonempty)
  (Hs : is_connected s) (Ht : is_connected t) : is_connected (s ∪ t) :=
begin
  rcases H with ⟨x, hx⟩,
  refine ⟨⟨x, mem_union_left t (mem_of_mem_inter_left hx)⟩, _⟩,
  exact is_preconnected.union x (mem_of_mem_inter_left hx) (mem_of_mem_inter_right hx)
    Hs.is_preconnected Ht.is_preconnected
end

/-- Theorem of bark and tree :
if a set is within a (pre)connected set and its closure,
then it is (pre)connected as well. -/
theorem is_preconnected.subset_closure {s : set α} {t : set α}
  (H : is_preconnected s) (Kst : s ⊆ t) (Ktcs : t ⊆ closure s) :
  is_preconnected t :=
λ u v hu hv htuv ⟨y, hyt, hyu⟩ ⟨z, hzt, hzv⟩,
let ⟨p, hpu, hps⟩ := mem_closure_iff.1 (Ktcs hyt) u hu hyu,
    ⟨q, hqv, hqs⟩ := mem_closure_iff.1 (Ktcs hzt) v hv hzv,
    ⟨r, hrs, hruv⟩ := H u v hu hv (subset.trans Kst htuv) ⟨p, hps, hpu⟩ ⟨q, hqs, hqv⟩ in
  ⟨r, Kst hrs, hruv⟩

theorem is_connected.subset_closure {s : set α}  {t : set α}
  (H : is_connected s) (Kst : s ⊆ t) (Ktcs : t ⊆ closure s): is_connected t :=
let hsne := H.left,
    ht := Kst,
    htne := nonempty.mono ht hsne in
    ⟨nonempty.mono Kst H.left, is_preconnected.subset_closure H.right Kst Ktcs ⟩

/-- The closure of a (pre)connected set is (pre)connected as well. -/
theorem is_preconnected.closure {s : set α} (H : is_preconnected s) :
  is_preconnected (closure s) :=
is_preconnected.subset_closure H subset_closure $ subset.refl $ closure s

theorem is_connected.closure {s : set α} (H : is_connected s) :
  is_connected (closure s) :=
is_connected.subset_closure H subset_closure $ subset.refl $ closure s

/-- The image of a (pre)connected set is (pre)connected as well. -/
theorem is_preconnected.image [topological_space β] {s : set α} (H : is_preconnected s)
  (f : α → β) (hf : continuous_on f s) : is_preconnected (f '' s) :=
begin
  -- Unfold/destruct definitions in hypotheses
  rintros u v hu hv huv ⟨_, ⟨x, xs, rfl⟩, xu⟩ ⟨_, ⟨y, ys, rfl⟩, yv⟩,
  rcases continuous_on_iff'.1 hf u hu with ⟨u', hu', u'_eq⟩,
  rcases continuous_on_iff'.1 hf v hv with ⟨v', hv', v'_eq⟩,
  -- Reformulate `huv : f '' s ⊆ u ∪ v` in terms of `u'` and `v'`
  replace huv : s ⊆ u' ∪ v',
  { rw [image_subset_iff, preimage_union] at huv,
    replace huv := subset_inter huv (subset.refl _),
    rw [inter_distrib_right, u'_eq, v'_eq, ← inter_distrib_right] at huv,
    exact (subset_inter_iff.1 huv).1 },
  -- Now `s ⊆ u' ∪ v'`, so we can apply `‹is_preconnected s›`
  obtain ⟨z, hz⟩ : (s ∩ (u' ∩ v')).nonempty,
  { refine H u' v' hu' hv' huv ⟨x, _⟩ ⟨y, _⟩; rw inter_comm,
    exacts [u'_eq ▸ ⟨xu, xs⟩, v'_eq ▸ ⟨yv, ys⟩] },
  rw [← inter_self s, inter_assoc, inter_left_comm s u', ← inter_assoc,
    inter_comm s, inter_comm s, ← u'_eq, ← v'_eq] at hz,
  exact ⟨f z, ⟨z, hz.1.2, rfl⟩, hz.1.1, hz.2.1⟩
end

theorem is_connected.image [topological_space β] {s : set α} (H : is_connected s)
  (f : α → β) (hf : continuous_on f s) : is_connected (f '' s) :=
⟨nonempty_image_iff.mpr H.nonempty, H.is_preconnected.image f hf⟩

theorem is_preconnected_closed_iff {s : set α} :
  is_preconnected s ↔ ∀ t t', is_closed t → is_closed t' → s ⊆ t ∪ t' →
    (s ∩ t).nonempty → (s ∩ t').nonempty → (s ∩ (t ∩ t')).nonempty :=
⟨begin
  rintros h t t' ht ht' htt' ⟨x, xs, xt⟩ ⟨y, ys, yt'⟩,
  by_contradiction h',
  rw [← ne_empty_iff_nonempty, ne.def, not_not, ← subset_compl_iff_disjoint, compl_inter] at h',
  have xt' : x ∉ t', from (h' xs).elim (absurd xt) id,
  have yt : y ∉ t, from (h' ys).elim id (absurd yt'),
  have := ne_empty_iff_nonempty.2 (h tᶜ t'ᶜ (is_open_compl_iff.2 ht)
    (is_open_compl_iff.2 ht') h' ⟨y, ys, yt⟩ ⟨x, xs, xt'⟩),
  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
  contradiction
end,
begin
  rintros h u v hu hv huv ⟨x, xs, xu⟩ ⟨y, ys, yv⟩,
  by_contradiction h',
  rw [← ne_empty_iff_nonempty, ne.def, not_not,
    ← subset_compl_iff_disjoint, compl_inter] at h',
  have xv : x ∉ v, from (h' xs).elim (absurd xu) id,
  have yu : y ∉ u, from (h' ys).elim id (absurd yv),
  have := ne_empty_iff_nonempty.2 (h uᶜ vᶜ (is_closed_compl_iff.2 hu)
    (is_closed_compl_iff.2 hv) h' ⟨y, ys, yu⟩ ⟨x, xs, xv⟩),
  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
  contradiction
end⟩

/- TODO: The following lemmas about connection of preimages hold more generally for strict maps
(the quotient and subspace topologies of the image agree) whose fibers are preconnected. -/

lemma is_preconnected.preimage_of_open_map [topological_space β] {s : set β}
  (hs : is_preconnected s) {f : α → β} (hinj : function.injective f) (hf : is_open_map f)
  (hsf : s ⊆ set.range f) :
  is_preconnected (f ⁻¹' s) :=
λ u v hu hv hsuv hsu hsv,
begin
  obtain ⟨b, hbs, hbu, hbv⟩ := hs (f '' u) (f '' v) (hf u hu) (hf v hv) _ _ _,
  obtain ⟨a, rfl⟩ := hsf hbs,
  rw hinj.mem_set_image at hbu hbv,
  exact ⟨a, hbs, hbu, hbv⟩,
  { have := set.image_subset f hsuv,
    rwa [set.image_preimage_eq_of_subset hsf, set.image_union] at this },
  { obtain ⟨x, hx1, hx2⟩ := hsu,
    exact ⟨f x, hx1, x, hx2, rfl⟩ },
  { obtain ⟨y, hy1, hy2⟩ := hsv,
    exact ⟨f y, hy1, y, hy2, rfl⟩ }
end

lemma is_preconnected.preimage_of_closed_map [topological_space β] {s : set β}
  (hs : is_preconnected s) {f : α → β} (hinj : function.injective f) (hf : is_closed_map f)
  (hsf : s ⊆ set.range f) :
  is_preconnected (f ⁻¹' s) :=
is_preconnected_closed_iff.2 $ λ u v hu hv hsuv hsu hsv,
begin
  obtain ⟨b, hbs, hbu, hbv⟩ :=
    is_preconnected_closed_iff.1 hs (f '' u) (f '' v) (hf u hu) (hf v hv) _ _ _,
  obtain ⟨a, rfl⟩ := hsf hbs,
  rw hinj.mem_set_image at hbu hbv,
  exact ⟨a, hbs, hbu, hbv⟩,
  { have := set.image_subset f hsuv,
    rwa [set.image_preimage_eq_of_subset hsf, set.image_union] at this },
  { obtain ⟨x, hx1, hx2⟩ := hsu,
    exact ⟨f x, hx1, x, hx2, rfl⟩ },
  { obtain ⟨y, hy1, hy2⟩ := hsv,
    exact ⟨f y, hy1, y, hy2, rfl⟩ }
end

lemma is_connected.preimage_of_open_map [topological_space β] {s : set β} (hs : is_connected s)
  {f : α → β} (hinj : function.injective f) (hf : is_open_map f) (hsf : s ⊆ set.range f) :
  is_connected (f ⁻¹' s) :=
⟨hs.nonempty.preimage' hsf, hs.is_preconnected.preimage_of_open_map hinj hf hsf⟩

lemma is_connected.preimage_of_closed_map [topological_space β] {s : set β} (hs : is_connected s)
  {f : α → β} (hinj : function.injective f) (hf : is_closed_map f) (hsf : s ⊆ set.range f) :
  is_connected (f ⁻¹' s) :=
⟨hs.nonempty.preimage' hsf, hs.is_preconnected.preimage_of_closed_map hinj hf hsf⟩

lemma is_preconnected.subset_or_subset (hu : is_open u) (hv : is_open v) (huv : disjoint u v)
  (hsuv : s ⊆ u ∪ v) (hs : is_preconnected s) :
  s ⊆ u ∨ s ⊆ v :=
begin
  specialize hs u v hu hv hsuv,
  obtain hsu | hsu := (s ∩ u).eq_empty_or_nonempty,
  { exact or.inr ((set.disjoint_iff_inter_eq_empty.2 hsu).subset_right_of_subset_union hsuv) },
  { replace hs := mt (hs hsu),
    simp_rw [set.not_nonempty_iff_eq_empty, ←set.disjoint_iff_inter_eq_empty,
      set.disjoint_iff_inter_eq_empty.1 huv] at hs,
    exact or.inl ((hs s.disjoint_empty).subset_left_of_subset_union hsuv) }
end

lemma is_preconnected.subset_left_of_subset_union (hu : is_open u) (hv : is_open v)
  (huv : disjoint u v) (hsuv : s ⊆ u ∪ v) (hsu : (s ∩ u).nonempty) (hs : is_preconnected s) :
  s ⊆ u :=
disjoint.subset_left_of_subset_union hsuv
begin
  by_contra hsv,
  rw set.not_disjoint_iff_nonempty_inter at hsv,
  obtain ⟨x, _, hx⟩ := hs u v hu hv hsuv hsu hsv,
  exact set.disjoint_iff.1 huv hx,
end

lemma is_preconnected.subset_right_of_subset_union (hu : is_open u) (hv : is_open v)
  (huv : disjoint u v) (hsuv : s ⊆ u ∪ v) (hsv : (s ∩ v).nonempty) (hs : is_preconnected s) :
  s ⊆ v :=
disjoint.subset_right_of_subset_union hsuv
begin
  by_contra hsu,
  rw set.not_disjoint_iff_nonempty_inter at hsu,
  obtain ⟨x, _, hx⟩ := hs u v hu hv hsuv hsu hsv,
  exact set.disjoint_iff.1 huv hx,
end

theorem is_preconnected.prod [topological_space β] {s : set α} {t : set β}
  (hs : is_preconnected s) (ht : is_preconnected t) :
  is_preconnected (s.prod t) :=
begin
  apply is_preconnected_of_forall_pair,
  rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ⟨ha₁, hb₁⟩ ⟨ha₂, hb₂⟩,
  refine ⟨prod.mk a₁ '' t ∪ flip prod.mk b₂ '' s, _,
    or.inl ⟨b₁, hb₁, rfl⟩, or.inr ⟨a₂, ha₂, rfl⟩, _⟩,
  { rintro _ (⟨y, hy, rfl⟩|⟨x, hx, rfl⟩),
    exacts [⟨ha₁, hy⟩, ⟨hx, hb₂⟩] },
  { exact (ht.image _ (continuous.prod.mk _).continuous_on).union (a₁, b₂) ⟨b₂, hb₂, rfl⟩
      ⟨a₁, ha₁, rfl⟩ (hs.image _ (continuous_id.prod_mk continuous_const).continuous_on) }
end

theorem is_connected.prod [topological_space β] {s : set α} {t : set β}
  (hs : is_connected s) (ht : is_connected t) : is_connected (s.prod t) :=
⟨hs.1.prod ht.1, hs.2.prod ht.2⟩

theorem is_preconnected_univ_pi [Π i, topological_space (π i)] {s : Π i, set (π i)}
  (hs : ∀ i, is_preconnected (s i)) :
  is_preconnected (pi univ s) :=
begin
  rintros u v uo vo hsuv ⟨f, hfs, hfu⟩ ⟨g, hgs, hgv⟩,
  rcases exists_finset_piecewise_mem_of_mem_nhds (uo.mem_nhds hfu) g with ⟨I, hI⟩,
  induction I using finset.induction_on with i I hi ihI,
  { refine ⟨g, hgs, ⟨_, hgv⟩⟩, simpa using hI },
  { rw [finset.piecewise_insert] at hI,
    have := I.piecewise_mem_set_pi hfs hgs,
    refine (hsuv this).elim ihI (λ h, _),
    set S := update (I.piecewise f g) i '' (s i),
    have hsub : S ⊆ pi univ s,
    { refine image_subset_iff.2 (λ z hz, _),
      rwa update_preimage_univ_pi,
      exact λ j hj, this j trivial },
    have hconn : is_preconnected S,
      from (hs i).image _ (continuous_const.update i continuous_id).continuous_on,
    have hSu : (S ∩ u).nonempty,
      from ⟨_, mem_image_of_mem _ (hfs _ trivial), hI⟩,
    have hSv : (S ∩ v).nonempty,
      from ⟨_, ⟨_, this _ trivial, update_eq_self _ _⟩, h⟩,
    refine (hconn u v uo vo (hsub.trans hsuv) hSu hSv).mono _,
    exact inter_subset_inter_left _ hsub }
end

@[simp] theorem is_connected_univ_pi [Π i, topological_space (π i)] {s : Π i, set (π i)} :
  is_connected (pi univ s) ↔ ∀ i, is_connected (s i) :=
begin
  simp only [is_connected, ← univ_pi_nonempty_iff, forall_and_distrib, and.congr_right_iff],
  refine λ hne, ⟨λ hc i, _, is_preconnected_univ_pi⟩,
  rw [← eval_image_univ_pi hne],
  exact hc.image _ (continuous_apply _).continuous_on
end

lemma sigma.is_connected_iff [Π i, topological_space (π i)] {s : set (Σ i, π i)} :
  is_connected s ↔ ∃ i t, is_connected t ∧ s = sigma.mk i '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain ⟨⟨i, x⟩, hx⟩ := hs.nonempty,
    have : s ⊆ set.range (sigma.mk i),
    { have h : set.range (sigma.mk i) = sigma.fst ⁻¹' {i}, by { ext, simp },
      rw h,
      exact is_preconnected.subset_left_of_subset_union
        (is_open_sigma_fst_preimage _) (is_open_sigma_fst_preimage {x | x ≠ i})
        (set.disjoint_iff.2 $ λ x hx, hx.2 hx.1)
        (λ y hy, by simp [classical.em]) ⟨⟨i, x⟩, hx, rfl⟩ hs.2 },
    exact ⟨i, sigma.mk i ⁻¹' s,
      hs.preimage_of_open_map sigma_mk_injective is_open_map_sigma_mk this,
      (set.image_preimage_eq_of_subset this).symm⟩ },
  { rintro ⟨i, t, ht, rfl⟩,
    exact ht.image _ continuous_sigma_mk.continuous_on }
end

lemma sigma.is_preconnected_iff [hι : nonempty ι] [Π i, topological_space (π i)]
  {s : set (Σ i, π i)} :
  is_preconnected s ↔ ∃ i t, is_preconnected t ∧ s = sigma.mk i '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain rfl | h := s.eq_empty_or_nonempty,
    { exact ⟨classical.choice hι, ∅, is_preconnected_empty, (set.image_empty _).symm⟩ },
    { obtain ⟨a, t, ht, rfl⟩ := sigma.is_connected_iff.1 ⟨h, hs⟩,
      refine ⟨a, t, ht.is_preconnected, rfl⟩ } },
  { rintro ⟨a, t, ht, rfl⟩,
    exact ht.image _ continuous_sigma_mk.continuous_on }
end

lemma sum.is_connected_iff [topological_space β] {s : set (α ⊕ β)} :
  is_connected s ↔
    (∃ t, is_connected t ∧ s = sum.inl '' t) ∨ ∃ t, is_connected t ∧ s = sum.inr '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { let u : set (α ⊕ β):= set.range sum.inl,
    let v : set (α ⊕ β) := set.range sum.inr,
    have hu : is_open u, exact is_open_range_inl,
    obtain ⟨x | x, hx⟩ := hs.nonempty,
    { have h := is_preconnected.subset_left_of_subset_union
        is_open_range_inl is_open_range_inr set.is_compl_range_inl_range_inr.disjoint
        (show s ⊆ set.range sum.inl ∪ set.range sum.inr, by simp) ⟨sum.inl x, hx, x, rfl⟩ hs.2,
      refine or.inl ⟨sum.inl ⁻¹' s, _, _⟩,
      { exact hs.preimage_of_open_map sum.inl_injective open_embedding_inl.is_open_map h },
      { exact (set.image_preimage_eq_of_subset h).symm } },
    { have h := is_preconnected.subset_right_of_subset_union
        is_open_range_inl is_open_range_inr set.is_compl_range_inl_range_inr.disjoint
        (show s ⊆ set.range sum.inl ∪ set.range sum.inr, by simp) ⟨sum.inr x, hx, x, rfl⟩ hs.2,
      refine or.inr ⟨sum.inr ⁻¹' s, _, _⟩,
      { exact hs.preimage_of_open_map sum.inr_injective open_embedding_inr.is_open_map h },
      { exact (set.image_preimage_eq_of_subset h).symm } } },
  { rintro (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩),
    { exact ht.image _ continuous_inl.continuous_on },
    { exact ht.image _ continuous_inr.continuous_on } }
end

lemma sum.is_preconnected_iff [topological_space β] {s : set (α ⊕ β)} :
  is_preconnected s ↔
    (∃ t, is_preconnected t ∧ s = sum.inl '' t) ∨ ∃ t, is_preconnected t ∧ s = sum.inr '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain rfl | h := s.eq_empty_or_nonempty,
    { exact or.inl ⟨∅, is_preconnected_empty, (set.image_empty _).symm⟩ },
    obtain ⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩ := sum.is_connected_iff.1 ⟨h, hs⟩,
    { exact or.inl ⟨t, ht.is_preconnected, rfl⟩ },
    { exact or.inr ⟨t, ht.is_preconnected, rfl⟩ } },
  { rintro (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩),
    { exact ht.image _ continuous_inl.continuous_on },
    { exact ht.image _ continuous_inr.continuous_on } }
end

/-- The connected component of a point is the maximal connected set
that contains this point. -/
def connected_component (x : α) : set α :=
⋃₀ { s : set α | is_preconnected s ∧ x ∈ s }

/-- The connected component of a point inside a set. -/
def connected_component_in (F : set α) (x : F) : set α := coe '' (connected_component x)

theorem mem_connected_component {x : α} : x ∈ connected_component x :=
mem_sUnion_of_mem (mem_singleton x) ⟨is_connected_singleton.is_preconnected, mem_singleton x⟩

theorem is_preconnected_connected_component {x : α} : is_preconnected (connected_component x) :=
is_preconnected_sUnion x _ (λ _, and.right) (λ _, and.left)

theorem is_connected_connected_component {x : α} : is_connected (connected_component x) :=
⟨⟨x, mem_connected_component⟩, is_preconnected_connected_component⟩

theorem is_preconnected.subset_connected_component {x : α} {s : set α}
  (H1 : is_preconnected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
λ z hz, mem_sUnion_of_mem hz ⟨H1, H2⟩

theorem is_connected.subset_connected_component {x : α} {s : set α}
  (H1 : is_connected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
H1.2.subset_connected_component H2

theorem connected_component_eq {x y : α} (h : y ∈ connected_component x) :
  connected_component x = connected_component y :=
eq_of_subset_of_subset
  (is_connected_connected_component.subset_connected_component h)
  (is_connected_connected_component.subset_connected_component
    (set.mem_of_mem_of_subset mem_connected_component
      (is_connected_connected_component.subset_connected_component h)))

lemma connected_component_disjoint {x y : α} (h : connected_component x ≠ connected_component y) :
  disjoint (connected_component x) (connected_component y) :=
set.disjoint_left.2 (λ a h1 h2, h
  ((connected_component_eq h1).trans (connected_component_eq h2).symm))

theorem is_closed_connected_component {x : α} :
  is_closed (connected_component x) :=
closure_eq_iff_is_closed.1 $ subset.antisymm
  (is_connected_connected_component.closure.subset_connected_component
    (subset_closure mem_connected_component))
  subset_closure

lemma continuous.image_connected_component_subset {β : Type*} [topological_space β] {f : α → β}
  (h : continuous f) (a : α) : f '' connected_component a ⊆ connected_component (f a) :=
(is_connected_connected_component.image f h.continuous_on).subset_connected_component
  ((mem_image f (connected_component a) (f a)).2 ⟨a, mem_connected_component, rfl⟩)

theorem irreducible_component_subset_connected_component {x : α} :
  irreducible_component x ⊆ connected_component x :=
is_irreducible_irreducible_component.is_connected.subset_connected_component
  mem_irreducible_component

/-- A preconnected space is one where there is no non-trivial open partition. -/
class preconnected_space (α : Type u) [topological_space α] : Prop :=
(is_preconnected_univ : is_preconnected (univ : set α))

export preconnected_space (is_preconnected_univ)

/-- A connected space is a nonempty one where there is no non-trivial open partition. -/
class connected_space (α : Type u) [topological_space α] extends preconnected_space α : Prop :=
(to_nonempty : nonempty α)

attribute [instance, priority 50] connected_space.to_nonempty -- see Note [lower instance priority]

lemma is_preconnected_range [topological_space β] [preconnected_space α] {f : α → β}
  (h : continuous f) : is_preconnected (range f) :=
@image_univ _ _ f ▸ is_preconnected_univ.image _ h.continuous_on

lemma is_connected_range [topological_space β] [connected_space α] {f : α → β} (h : continuous f) :
  is_connected (range f) :=
⟨range_nonempty f, is_preconnected_range h⟩

lemma dense_range.preconnected_space [topological_space β] [preconnected_space α] {f : α → β}
  (hf : dense_range f) (hc : continuous f) :
  preconnected_space β :=
⟨hf.closure_eq ▸ (is_preconnected_range hc).closure⟩

lemma connected_space_iff_connected_component :
  connected_space α ↔ ∃ x : α, connected_component x = univ :=
begin
  split,
  { rintros ⟨h, ⟨x⟩⟩,
    exactI ⟨x, eq_univ_of_univ_subset $
      is_preconnected_univ.subset_connected_component (mem_univ x)⟩ },
  { rintros ⟨x, h⟩,
    haveI : preconnected_space α := ⟨by { rw ← h, exact is_preconnected_connected_component }⟩,
    exact ⟨⟨x⟩⟩ }
end

instance [topological_space β] [preconnected_space α] [preconnected_space β] :
  preconnected_space (α × β) :=
⟨by { rw ← univ_prod_univ, exact is_preconnected_univ.prod is_preconnected_univ }⟩

instance [topological_space β] [connected_space α] [connected_space β] :
  connected_space (α × β) :=
⟨prod.nonempty⟩

instance [Π i, topological_space (π i)] [∀ i, preconnected_space (π i)] :
  preconnected_space (Π i, π i) :=
⟨by { rw ← pi_univ univ, exact is_preconnected_univ_pi (λ i, is_preconnected_univ) }⟩

instance [Π i, topological_space (π i)] [∀ i, connected_space (π i)] : connected_space (Π i, π i) :=
⟨classical.nonempty_pi.2 $ λ i, by apply_instance⟩

@[priority 100] -- see Note [lower instance priority]
instance preirreducible_space.preconnected_space (α : Type u) [topological_space α]
  [preirreducible_space α] : preconnected_space α :=
⟨(preirreducible_space.is_preirreducible_univ α).is_preconnected⟩

@[priority 100] -- see Note [lower instance priority]
instance irreducible_space.connected_space (α : Type u) [topological_space α]
  [irreducible_space α] : connected_space α :=
{ to_nonempty := irreducible_space.to_nonempty α }

theorem nonempty_inter [preconnected_space α] {s t : set α} :
  is_open s → is_open t → s ∪ t = univ → s.nonempty → t.nonempty → (s ∩ t).nonempty :=
by simpa only [univ_inter, univ_subset_iff] using
  @preconnected_space.is_preconnected_univ α _ _ s t

theorem is_clopen_iff [preconnected_space α] {s : set α} : is_clopen s ↔ s = ∅ ∨ s = univ :=
⟨λ hs, classical.by_contradiction $ λ h,
  have h1 : s ≠ ∅ ∧ sᶜ ≠ ∅, from ⟨mt or.inl h,
    mt (λ h2, or.inr $ (by rw [← compl_compl s, h2, compl_empty] : s = univ)) h⟩,
  let ⟨_, h2, h3⟩ := nonempty_inter hs.1 hs.2.is_open_compl (union_compl_self s)
    (ne_empty_iff_nonempty.1 h1.1) (ne_empty_iff_nonempty.1 h1.2) in
  h3 h2,
by rintro (rfl | rfl); [exact is_clopen_empty, exact is_clopen_univ]⟩

lemma eq_univ_of_nonempty_clopen [preconnected_space α] {s : set α}
  (h : s.nonempty) (h' : is_clopen s) : s = univ :=
by { rw is_clopen_iff at h', finish [h.ne_empty] }

lemma subtype.preconnected_space {s : set α} (h : is_preconnected s) :
  preconnected_space s :=
{ is_preconnected_univ :=
  begin
    intros u v hu hv hs hsu hsv,
    rw is_open_induced_iff at hu hv,
    rcases hu with ⟨u, hu, rfl⟩,
    rcases hv with ⟨v, hv, rfl⟩,
    rcases hsu with ⟨⟨x, hxs⟩, hxs', hxu⟩,
    rcases hsv with ⟨⟨y, hys⟩, hys', hyv⟩,
    rcases h u v hu hv _ ⟨x, hxs, hxu⟩ ⟨y, hys, hyv⟩ with ⟨z, hzs, ⟨hzu, hzv⟩⟩,
    exact ⟨⟨z, hzs⟩, ⟨set.mem_univ _, ⟨hzu, hzv⟩⟩⟩,
    intros z hz,
    rcases hs (mem_univ ⟨z, hz⟩) with hzu|hzv,
    { left, assumption },
    { right, assumption }
  end }

lemma subtype.connected_space {s : set α} (h : is_connected s) :
  connected_space s :=
{ is_preconnected_univ :=
  (subtype.preconnected_space h.is_preconnected).is_preconnected_univ,
  to_nonempty := h.nonempty.to_subtype }

lemma is_preconnected_iff_preconnected_space {s : set α} :
  is_preconnected s ↔ preconnected_space s :=
⟨subtype.preconnected_space,
 begin
   introI,
   simpa using is_preconnected_univ.image (coe : s → α) continuous_subtype_coe.continuous_on
 end⟩

lemma is_connected_iff_connected_space {s : set α} : is_connected s ↔ connected_space s :=
⟨subtype.connected_space,
 λ h, ⟨nonempty_subtype.mp h.2, is_preconnected_iff_preconnected_space.mpr h.1⟩⟩

/-- A set `s` is preconnected if and only if
for every cover by two open sets that are disjoint on `s`,
it is contained in one of the two covering sets. -/
lemma is_preconnected_iff_subset_of_disjoint {s : set α} :
  is_preconnected s ↔
  ∀ (u v : set α) (hu : is_open u) (hv : is_open v) (hs : s ⊆ u ∪ v) (huv : s ∩ (u ∩ v) = ∅),
  s ⊆ u ∨ s ⊆ v :=
begin
  split; intro h,
  { intros u v hu hv hs huv,
    specialize h u v hu hv hs,
    contrapose! huv,
    rw ne_empty_iff_nonempty,
    simp [not_subset] at huv,
    rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
    have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
    have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
    exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
  { intros u v hu hv hs hsu hsv,
    rw ← ne_empty_iff_nonempty,
    intro H,
    specialize h u v hu hv hs H,
    contrapose H,
    apply ne_empty_iff_nonempty.mpr,
    cases h,
    { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
    { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
end

/-- A set `s` is connected if and only if
for every cover by a finite collection of open sets that are pairwise disjoint on `s`,
it is contained in one of the members of the collection. -/
lemma is_connected_iff_sUnion_disjoint_open {s : set α} :
  is_connected s ↔
  ∀ (U : finset (set α)) (H : ∀ (u v : set α), u ∈ U → v ∈ U → (s ∩ (u ∩ v)).nonempty → u = v)
  (hU : ∀ u ∈ U, is_open u) (hs : s ⊆ ⋃₀ ↑U),
  ∃ u ∈ U, s ⊆ u :=
begin
  rw [is_connected, is_preconnected_iff_subset_of_disjoint],
  split; intro h,
  { intro U, apply finset.induction_on U,
    { rcases h.left,
      suffices : s ⊆ ∅ → false, { simpa },
      intro, solve_by_elim },
    { intros u U hu IH hs hU H,
      rw [finset.coe_insert, sUnion_insert] at H,
      cases h.2 u (⋃₀ ↑U) _ _ H _ with hsu hsU,
      { exact ⟨u, finset.mem_insert_self _ _, hsu⟩ },
      { rcases IH _ _ hsU with ⟨v, hvU, hsv⟩,
        { exact ⟨v, finset.mem_insert_of_mem hvU, hsv⟩ },
        { intros, apply hs; solve_by_elim [finset.mem_insert_of_mem] },
        { intros, solve_by_elim [finset.mem_insert_of_mem] } },
      { solve_by_elim [finset.mem_insert_self] },
      { apply is_open_sUnion,
        intros, solve_by_elim [finset.mem_insert_of_mem] },
      { apply eq_empty_of_subset_empty,
        rintro x ⟨hxs, hxu, hxU⟩,
        rw mem_sUnion at hxU,
        rcases hxU with ⟨v, hvU, hxv⟩,
        rcases hs u v (finset.mem_insert_self _ _) (finset.mem_insert_of_mem hvU) _ with rfl,
        { contradiction },
        { exact ⟨x, hxs, hxu, hxv⟩ } } } },
  { split,
    { rw ← ne_empty_iff_nonempty,
      by_contradiction hs, subst hs,
      simpa using h ∅ _ _ _; simp },
    intros u v hu hv hs hsuv,
    rcases h {u, v} _ _ _ with ⟨t, ht, ht'⟩,
    { rw [finset.mem_insert, finset.mem_singleton] at ht,
      rcases ht with rfl|rfl; tauto },
    { intros t₁ t₂ ht₁ ht₂ hst,
      rw ← ne_empty_iff_nonempty at hst,
      rw [finset.mem_insert, finset.mem_singleton] at ht₁ ht₂,
      rcases ht₁ with rfl|rfl; rcases ht₂ with rfl|rfl,
      all_goals { refl <|> contradiction <|> skip },
      rw inter_comm t₁ at hst, contradiction },
    { intro t,
      rw [finset.mem_insert, finset.mem_singleton],
      rintro (rfl|rfl); assumption },
    { simpa using hs } }
end

/-- Preconnected sets are either contained in or disjoint to any given clopen set. -/
theorem subset_or_disjoint_of_clopen {α : Type*} [topological_space α] {s t : set α}
  (h : is_preconnected t) (h1 : is_clopen s) : s ∩ t = ∅ ∨ t ⊆ s :=
begin
  by_contradiction h2,
  have h3 : (s ∩ t).nonempty := ne_empty_iff_nonempty.mp (mt or.inl h2),
  have h4 : (t ∩ sᶜ).nonempty,
  { apply inter_compl_nonempty_iff.2,
    push_neg at h2,
    exact h2.2 },
  rw [inter_comm] at h3,
  apply ne_empty_iff_nonempty.2 (h s sᶜ h1.1 (is_open_compl_iff.2 h1.2) _ h3 h4),
  { rw [inter_compl_self, inter_empty] },
  { rw [union_compl_self],
    exact subset_univ t },
end

/-- A set `s` is preconnected if and only if
for every cover by two closed sets that are disjoint on `s`,
it is contained in one of the two covering sets. -/
theorem is_preconnected_iff_subset_of_disjoint_closed {α : Type*} {s : set α}
  [topological_space α] :
  is_preconnected s ↔
    ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hs : s ⊆ u ∪ v) (huv : s ∩ (u ∩ v) = ∅),
      s ⊆ u ∨ s ⊆ v :=
begin
  split; intro h,
  { intros u v hu hv hs huv,
    rw is_preconnected_closed_iff at h,
    specialize h u v hu hv hs,
    contrapose! huv,
    rw ne_empty_iff_nonempty,
    simp [not_subset] at huv,
    rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
    have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
    have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
    exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
  { rw is_preconnected_closed_iff,
    intros u v hu hv hs hsu hsv,
    rw ← ne_empty_iff_nonempty,
    intro H,
    specialize h u v hu hv hs H,
    contrapose H,
    apply ne_empty_iff_nonempty.mpr,
    cases h,
    { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
    { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
end

/-- A closed set `s` is preconnected if and only if
for every cover by two closed sets that are disjoint,
it is contained in one of the two covering sets. -/
theorem is_preconnected_iff_subset_of_fully_disjoint_closed {s : set α} (hs : is_closed s) :
  is_preconnected s ↔
  ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hss : s ⊆ u ∪ v) (huv : u ∩ v = ∅),
  s ⊆ u ∨ s ⊆ v :=
begin
  split,
  { intros h u v hu hv hss huv,
    apply is_preconnected_iff_subset_of_disjoint_closed.1 h u v hu hv hss,
    rw huv,
    exact inter_empty s },
  intro H,
  rw is_preconnected_iff_subset_of_disjoint_closed,
  intros u v hu hv hss huv,
  have H1 := H (u ∩ s) (v ∩ s),
  rw [subset_inter_iff, subset_inter_iff] at H1,
  simp only [subset.refl, and_true] at H1,
  apply H1 (is_closed.inter hu hs) (is_closed.inter hv hs),
  { rw ←inter_distrib_right,
    apply subset_inter_iff.2,
    exact ⟨hss, subset.refl s⟩ },
  { rw [inter_comm v s, inter_assoc, ←inter_assoc s, inter_self s,
        inter_comm, inter_assoc, inter_comm v u, huv] }
end

/-- The connected component of a point is always a subset of the intersection of all its clopen
neighbourhoods. -/
lemma connected_component_subset_Inter_clopen {x : α} :
  connected_component x ⊆ ⋂ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, Z :=
begin
  apply subset_Inter (λ Z, _),
  cases (subset_or_disjoint_of_clopen (@is_connected_connected_component _ _ x).2 Z.2.1),
  { exfalso,
    apply nonempty.ne_empty
      (nonempty_of_mem (mem_inter (@mem_connected_component _ _ x) Z.2.2)),
    rw inter_comm,
    exact h },
  exact h,
end

/-- A clopen set is the union of its connected components. -/
lemma is_clopen.eq_union_connected_components {Z : set α} (h : is_clopen Z) :
  Z = (⋃ (x : α) (H : x ∈ Z), connected_component x) :=
eq_of_subset_of_subset (λ x xZ, mem_Union.2 ⟨x, mem_Union.2 ⟨xZ, mem_connected_component⟩⟩)
  (Union_subset $ λ x, Union_subset $ λ xZ,
    (by { apply subset.trans connected_component_subset_Inter_clopen
      (Inter_subset _ ⟨Z, ⟨h, xZ⟩⟩) }))

/-- The preimage of a connected component is preconnected if the function has connected fibers
and a subset is closed iff the preimage is. -/
lemma preimage_connected_component_connected {β : Type*} [topological_space β] {f : α → β}
  (connected_fibers : ∀ t : β, is_connected (f ⁻¹' {t}))
  (hcl : ∀ (T : set β), is_closed T ↔ is_closed (f ⁻¹' T)) (t : β) :
  is_connected (f ⁻¹' connected_component t) :=
begin
  -- The following proof is essentially https://stacks.math.columbia.edu/tag/0377
  -- although the statement is slightly different
  have hf : surjective f := surjective.of_comp (λ t : β, (connected_fibers t).1),

  split,
  { cases hf t with s hs,
    use s,
    rw [mem_preimage, hs],
    exact mem_connected_component },

  have hT : is_closed (f ⁻¹' connected_component t) :=
    (hcl (connected_component t)).1 is_closed_connected_component,

  -- To show it's preconnected we decompose (f ⁻¹' connected_component t) as a subset of two
  -- closed disjoint sets in α. We want to show that it's a subset of either.
  rw is_preconnected_iff_subset_of_fully_disjoint_closed hT,
  intros u v hu hv huv uv_disj,

  -- To do this we decompose connected_component t into T₁ and T₂
  -- we will show that connected_component t is a subset of either and hence
  -- (f ⁻¹' connected_component t) is a subset of u or v
  let T₁ := {t' ∈ connected_component t | f ⁻¹' {t'} ⊆ u},
  let T₂ := {t' ∈ connected_component t | f ⁻¹' {t'} ⊆ v},

  have fiber_decomp : ∀ t' ∈ connected_component t, f ⁻¹' {t'} ⊆ u ∨ f ⁻¹' {t'} ⊆ v,
  { intros t' ht',
    apply is_preconnected_iff_subset_of_disjoint_closed.1 (connected_fibers t').2 u v hu hv,
    { exact subset.trans (hf.preimage_subset_preimage_iff.2 (singleton_subset_iff.2 ht')) huv },
    rw uv_disj,
    exact inter_empty _ },

  have T₁_u : f ⁻¹' T₁ = (f ⁻¹' connected_component t) ∩ u,
  { apply eq_of_subset_of_subset,
    { rw ←bUnion_preimage_singleton,
      refine bUnion_subset (λ t' ht', subset_inter _ ht'.2),
      rw [hf.preimage_subset_preimage_iff, singleton_subset_iff],
      exact ht'.1 },
    rintros a ⟨hat, hau⟩,
    constructor,
    { exact mem_preimage.1 hat },
    dsimp only,
    cases fiber_decomp (f a) (mem_preimage.1 hat),
    { exact h },
    { exfalso,
      rw ←not_nonempty_iff_eq_empty at uv_disj,
      exact uv_disj (nonempty_of_mem (mem_inter hau (h rfl))) } },
  -- This proof is exactly the same as the above (modulo some symmetry)
  have T₂_v : f ⁻¹' T₂ = (f ⁻¹' connected_component t) ∩ v,
  { apply eq_of_subset_of_subset,
    { rw ←bUnion_preimage_singleton,
      refine bUnion_subset (λ t' ht', subset_inter _ ht'.2),
      rw [hf.preimage_subset_preimage_iff, singleton_subset_iff],
      exact ht'.1 },
    rintros a ⟨hat, hav⟩,
    constructor,
    { exact mem_preimage.1 hat },
    dsimp only,
    cases fiber_decomp (f a) (mem_preimage.1 hat),
    { exfalso,
      rw ←not_nonempty_iff_eq_empty at uv_disj,
      exact uv_disj (nonempty_of_mem (mem_inter (h rfl) hav)) },
    { exact h } },

  -- Now we show T₁, T₂ are closed, cover connected_component t and are disjoint.
  have hT₁ : is_closed T₁ := ((hcl T₁).2 (T₁_u.symm ▸ (is_closed.inter hT hu))),
  have hT₂ : is_closed T₂ := ((hcl T₂).2 (T₂_v.symm ▸ (is_closed.inter hT hv))),

  have T_decomp : connected_component t ⊆ T₁ ∪ T₂,
  { intros t' ht',
    rw mem_union t' T₁ T₂,
    cases fiber_decomp t' ht' with htu htv,
    { left, exact ⟨ht', htu⟩ },
    right, exact ⟨ht', htv⟩ },

  have T_disjoint : T₁ ∩ T₂ = ∅,
  { rw ←image_preimage_eq (T₁ ∩ T₂) hf,
    suffices : f ⁻¹' (T₁ ∩ T₂) = ∅,
    { rw this, exact image_empty _ },
    rw [preimage_inter, T₁_u, T₂_v],
    rw inter_comm at uv_disj,
    conv
    { congr,
      rw [inter_assoc],
      congr, skip,
      rw [←inter_assoc, inter_comm, ←inter_assoc, uv_disj, empty_inter], },
    exact inter_empty _ },

  -- Now we do cases on whether (connected_component t) is a subset of T₁ or T₂ to show
  -- that the preimage is a subset of u or v.
  cases (is_preconnected_iff_subset_of_fully_disjoint_closed is_closed_connected_component).1
    is_preconnected_connected_component T₁ T₂ hT₁ hT₂ T_decomp T_disjoint,
  { left,
    rw subset.antisymm_iff at T₁_u,
    suffices : f ⁻¹' connected_component t ⊆ f ⁻¹' T₁,
    { exact subset.trans (subset.trans this T₁_u.1) (inter_subset_right _ _) },
    exact preimage_mono h },
  right,
  rw subset.antisymm_iff at T₂_v,
  suffices : f ⁻¹' connected_component t ⊆ f ⁻¹' T₂,
  { exact subset.trans (subset.trans this T₂_v.1) (inter_subset_right _ _) },
  exact preimage_mono h,
end

end preconnected

section totally_disconnected

/-- A set `s` is called totally disconnected if every subset `t ⊆ s` which is preconnected is
a subsingleton, ie either empty or a singleton.-/
def is_totally_disconnected (s : set α) : Prop :=
∀ t, t ⊆ s → is_preconnected t → t.subsingleton

theorem is_totally_disconnected_empty : is_totally_disconnected (∅ : set α) :=
λ _ ht _ _ x_in _ _, (ht x_in).elim

theorem is_totally_disconnected_singleton {x} : is_totally_disconnected ({x} : set α) :=
λ _ ht _, subsingleton.mono subsingleton_singleton ht

/-- A space is totally disconnected if all of its connected components are singletons. -/
class totally_disconnected_space (α : Type u) [topological_space α] : Prop :=
(is_totally_disconnected_univ : is_totally_disconnected (univ : set α))

lemma is_preconnected.subsingleton [totally_disconnected_space α]
  {s : set α} (h : is_preconnected s) : s.subsingleton :=
totally_disconnected_space.is_totally_disconnected_univ s (subset_univ s) h

instance pi.totally_disconnected_space {α : Type*} {β : α → Type*}
  [t₂ : Πa, topological_space (β a)] [∀a, totally_disconnected_space (β a)] :
  totally_disconnected_space (Π (a : α), β a) :=
⟨λ t h1 h2,
  have this : ∀ a, is_preconnected ((λ x : Π a, β a, x a) '' t),
    from λ a, h2.image (λ x, x a) (continuous_apply a).continuous_on,
  λ x x_in y y_in, funext $ λ a, (this a).subsingleton ⟨x, x_in, rfl⟩ ⟨y, y_in, rfl⟩⟩

instance prod.totally_disconnected_space [topological_space β]
  [totally_disconnected_space α] [totally_disconnected_space β] :
  totally_disconnected_space (α × β) :=
⟨λ t h1 h2,
have H1 : is_preconnected (prod.fst '' t), from h2.image prod.fst continuous_fst.continuous_on,
have H2 : is_preconnected (prod.snd '' t), from h2.image prod.snd continuous_snd.continuous_on,
λ x hx y hy, prod.ext
  (H1.subsingleton ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩)
  (H2.subsingleton ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩)⟩

instance [topological_space β] [totally_disconnected_space α] [totally_disconnected_space β] :
  totally_disconnected_space (α ⊕ β) :=
begin
  refine ⟨λ s _ hs, _⟩,
  obtain (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩) := sum.is_preconnected_iff.1 hs,
  { exact ht.subsingleton.image _ },
  { exact ht.subsingleton.image _ }
end

instance [Π i, topological_space (π i)] [∀ i, totally_disconnected_space (π i)] :
  totally_disconnected_space (Σ i, π i) :=
begin
  refine ⟨λ s _ hs, _⟩,
  obtain rfl | h := s.eq_empty_or_nonempty,
  { exact set.subsingleton_empty },
  { obtain ⟨a, t, ht, rfl⟩ := sigma.is_connected_iff.1 ⟨h, hs⟩,
    exact ht.is_preconnected.subsingleton.image _ }
end

/-- A space is totally disconnected iff its connected components are subsingletons. -/
lemma totally_disconnected_space_iff_connected_component_subsingleton :
  totally_disconnected_space α ↔ ∀ x : α, (connected_component x).subsingleton :=
begin
  split,
  { intros h x,
    apply h.1,
    { exact subset_univ _ },
    exact is_preconnected_connected_component },
  intro h, constructor,
  intros s s_sub hs,
  rcases eq_empty_or_nonempty s with rfl | ⟨x, x_in⟩,
  { exact subsingleton_empty },
  { exact (h x).mono (hs.subset_connected_component x_in) }
end

/-- A space is totally disconnected iff its connected components are singletons. -/
lemma totally_disconnected_space_iff_connected_component_singleton :
  totally_disconnected_space α ↔ ∀ x : α, connected_component x = {x} :=
begin
  rw totally_disconnected_space_iff_connected_component_subsingleton,
  apply forall_congr (λ x, _),
  rw set.subsingleton_iff_singleton,
  exact mem_connected_component
end

/-- The image of a connected component in a totally disconnected space is a singleton. -/
@[simp] lemma continuous.image_connected_component_eq_singleton {β : Type*} [topological_space β]
  [totally_disconnected_space β] {f : α → β} (h : continuous f) (a : α) :
  f '' connected_component a = {f a} :=
(set.subsingleton_iff_singleton $ mem_image_of_mem f mem_connected_component).mp
  (is_preconnected_connected_component.image f h.continuous_on).subsingleton

lemma is_totally_disconnected_of_totally_disconnected_space [totally_disconnected_space α]
  (s : set α) : is_totally_disconnected s :=
λ t hts ht, totally_disconnected_space.is_totally_disconnected_univ _ t.subset_univ ht

lemma is_totally_disconnected_of_image [topological_space β] {f : α → β} (hf : continuous_on f s)
  (hf' : injective f) (h : is_totally_disconnected (f '' s)) : is_totally_disconnected s :=
λ t hts ht x x_in y y_in, hf' $ h _ (image_subset f hts) (ht.image f $ hf.mono hts)
  (mem_image_of_mem f x_in) (mem_image_of_mem f y_in)

lemma embedding.is_totally_disconnected [topological_space β] {f : α → β} (hf : embedding f)
  {s : set α} (h : is_totally_disconnected (f '' s)) : is_totally_disconnected s :=
is_totally_disconnected_of_image hf.continuous.continuous_on hf.inj h

instance subtype.totally_disconnected_space {α : Type*} {p : α → Prop} [topological_space α]
  [totally_disconnected_space α] : totally_disconnected_space (subtype p) :=
⟨embedding_subtype_coe.is_totally_disconnected
  (is_totally_disconnected_of_totally_disconnected_space _)⟩

end totally_disconnected

section totally_separated

/-- A set `s` is called totally separated if any two points of this set can be separated
by two disjoint open sets covering `s`. -/
def is_totally_separated (s : set α) : Prop :=
∀ x ∈ s, ∀ y ∈ s, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧
  x ∈ u ∧ y ∈ v ∧ s ⊆ u ∪ v ∧ u ∩ v = ∅

theorem is_totally_separated_empty : is_totally_separated (∅ : set α) :=
λ x, false.elim

theorem is_totally_separated_singleton {x} : is_totally_separated ({x} : set α) :=
λ p hp q hq hpq, (hpq $ (eq_of_mem_singleton hp).symm ▸ (eq_of_mem_singleton hq).symm).elim

theorem is_totally_disconnected_of_is_totally_separated {s : set α}
  (H : is_totally_separated s) : is_totally_disconnected s :=
begin
  intros t hts ht x x_in y y_in,
  by_contra h,
  obtain ⟨u : set α, v : set α, hu : is_open u, hv : is_open v,
          hxu : x ∈ u, hyv : y ∈ v, hs : s ⊆ u ∪ v, huv : u ∩ v = ∅⟩ :=
    H x (hts x_in) y (hts y_in) h,
  have : (t ∩ u).nonempty → (t ∩ v).nonempty → (t ∩ (u ∩ v)).nonempty :=
    ht _ _ hu hv (subset.trans hts hs),
  obtain ⟨z, hz : z ∈ t ∩ (u ∩ v)⟩ := this ⟨x, x_in, hxu⟩ ⟨y, y_in, hyv⟩,
  simpa [huv] using hz
end

alias is_totally_disconnected_of_is_totally_separated ← is_totally_separated.is_totally_disconnected

/-- A space is totally separated if any two points can be separated by two disjoint open sets
covering the whole space. -/
class totally_separated_space (α : Type u) [topological_space α] : Prop :=
(is_totally_separated_univ [] : is_totally_separated (univ : set α))

@[priority 100] -- see Note [lower instance priority]
instance totally_separated_space.totally_disconnected_space (α : Type u) [topological_space α]
  [totally_separated_space α] : totally_disconnected_space α :=
⟨is_totally_disconnected_of_is_totally_separated $
  totally_separated_space.is_totally_separated_univ α⟩

@[priority 100] -- see Note [lower instance priority]
instance totally_separated_space.of_discrete
  (α : Type*) [topological_space α] [discrete_topology α] : totally_separated_space α :=
⟨λ a _ b _ h, ⟨{b}ᶜ, {b}, is_open_discrete _, is_open_discrete _, by simpa⟩⟩

lemma exists_clopen_of_totally_separated {α : Type*} [topological_space α]
  [totally_separated_space α] {x y : α} (hxy : x ≠ y) :
  ∃ (U : set α) (hU : is_clopen U), x ∈ U ∧ y ∈ Uᶜ :=
begin
  obtain ⟨U, V, hU, hV, Ux, Vy, f, disj⟩ :=
    totally_separated_space.is_totally_separated_univ α x (set.mem_univ x) y (set.mem_univ y) hxy,
  have clopen_U := is_clopen_inter_of_disjoint_cover_clopen (is_clopen_univ) f hU hV disj,
  rw set.univ_inter _ at clopen_U,
  rw [←set.subset_compl_iff_disjoint, set.subset_compl_comm] at disj,
  exact ⟨U, clopen_U, Ux, disj Vy⟩,
end

end totally_separated

section connected_component_setoid

/-- The setoid of connected components of a topological space -/
def connected_component_setoid (α : Type*) [topological_space α] : setoid α :=
⟨λ x y, connected_component x = connected_component y,
  ⟨λ x, by trivial, λ x y h1, h1.symm, λ x y z h1 h2, h1.trans h2⟩⟩
-- see Note [lower instance priority]
local attribute [instance, priority 100] connected_component_setoid

lemma connected_component_rel_iff {x y : α} : ⟦x⟧ = ⟦y⟧ ↔
  connected_component x = connected_component y :=
⟨λ h, quotient.exact h, λ h, quotient.sound h⟩

lemma connected_component_nrel_iff {x y : α} : ⟦x⟧ ≠ ⟦y⟧ ↔
  connected_component x ≠ connected_component y :=
by { rw not_iff_not, exact connected_component_rel_iff }

/-- The quotient of a space by its connected components -/
def connected_components (α : Type u) [topological_space α] :=
  quotient (connected_component_setoid α)

instance [inhabited α] : inhabited (connected_components α) := ⟨quotient.mk (default _)⟩
instance connected_components.topological_space : topological_space (connected_components α) :=
  quotient.topological_space

lemma continuous.image_eq_of_equiv {β : Type*} [topological_space β] [totally_disconnected_space β]
  {f : α → β} (h : continuous f) (a b : α) (hab : a ≈ b) : f a = f b :=
singleton_eq_singleton_iff.1 $
  h.image_connected_component_eq_singleton a ▸
  h.image_connected_component_eq_singleton b ▸ hab ▸ rfl

/--
The lift to `connected_components α` of a continuous map from `α` to a totally disconnected space
-/
def continuous.connected_components_lift {β : Type*} [topological_space β]
  [totally_disconnected_space β] {f : α → β} (h : continuous f) : connected_components α → β :=
quotient.lift f h.image_eq_of_equiv

@[continuity] lemma continuous.connected_components_lift_continuous {β : Type*}
  [topological_space β] [totally_disconnected_space β] {f : α → β} (h : continuous f) :
  continuous h.connected_components_lift :=
continuous_quotient_lift h.image_eq_of_equiv h

@[simp] lemma continuous.connected_components_lift_factors {β : Type*} [topological_space β]
  [totally_disconnected_space β] {f : α → β} (h : continuous f) :
  h.connected_components_lift ∘ quotient.mk = f := rfl

lemma continuous.connected_components_lift_unique {β : Type*} [topological_space β]
  [totally_disconnected_space β] {f : α → β} (h : continuous f) (g : connected_components α → β)
  (hg : g ∘ quotient.mk = f) : g = h.connected_components_lift :=
by { subst hg, ext1 x, exact quotient.induction_on x (λ a, refl _) }

lemma connected_components_lift_unique' {β : Type*} (g₁ : connected_components α → β)
  (g₂ : connected_components α → β) (hg : g₁ ∘ quotient.mk = g₂ ∘ quotient.mk ) : g₁ = g₂ :=
begin
  ext1 x,
  refine quotient.induction_on x (λ a, _),
  change (g₁ ∘ quotient.mk) a = (g₂ ∘ quotient.mk) a,
  rw hg,
end

/-- The preimage of a singleton in `connected_components` is the connected component
of an element in the equivalence class. -/
lemma connected_components_preimage_singleton {t : α} :
  connected_component t = quotient.mk ⁻¹' {⟦t⟧} :=
begin
  apply set.eq_of_subset_of_subset; intros a ha,
  { have H : ⟦a⟧ = ⟦t⟧ := quotient.sound (connected_component_eq ha).symm,
    rw [mem_preimage, H],
    exact mem_singleton ⟦t⟧ },
  rw [mem_preimage, mem_singleton_iff] at ha,
  have ha' : connected_component a = connected_component t := quotient.exact ha,
  rw ←ha',
  exact mem_connected_component,
end

/-- The preimage of the image of a set under the quotient map to `connected_components α`
is the union of the connected components of the elements in it. -/
lemma connected_components_preimage_image (U : set α) :
  quotient.mk ⁻¹' (quotient.mk '' U) = ⋃ (x : α) (h : x ∈ U), connected_component x :=
begin
  apply set.eq_of_subset_of_subset,
  { rintros a ⟨b, hb, hab⟩,
    refine mem_Union.2 ⟨b, mem_Union.2 ⟨hb, _⟩⟩,
    rw connected_component_rel_iff.1 hab,
    exact mem_connected_component },
  refine Union_subset (λ a, Union_subset (λ ha, _)),
  rw [connected_components_preimage_singleton,
    (surjective_quotient_mk _).preimage_subset_preimage_iff, singleton_subset_iff],
  exact ⟨a, ha, refl _⟩,
end

instance connected_components.totally_disconnected_space :
  totally_disconnected_space (connected_components α) :=
begin
  rw totally_disconnected_space_iff_connected_component_singleton,
  refine λ x, quotient.induction_on x (λ a, _),
  apply eq_of_subset_of_subset _ (singleton_subset_iff.2 mem_connected_component),
  rw subset_singleton_iff,
  refine λ x, quotient.induction_on x (λ b hb, _),
  rw [connected_component_rel_iff, connected_component_eq],
  suffices : is_preconnected (quotient.mk ⁻¹' connected_component ⟦a⟧),
  { apply mem_of_subset_of_mem (this.subset_connected_component hb),
    exact mem_preimage.2 mem_connected_component },
  apply (@preimage_connected_component_connected _ _ _ _ _ _ _ _).2,
  { refine λ t, quotient.induction_on t (λ s, _),
    rw ←connected_components_preimage_singleton,
    exact is_connected_connected_component },
  refine λ T, ⟨λ hT, hT.preimage continuous_quotient_mk, λ hT, _⟩,
  rwa [← is_open_compl_iff, ← preimage_compl, quotient_map_quotient_mk.is_open_preimage,
    is_open_compl_iff] at hT,
end

/-- Functoriality of `connected_components` -/
def continuous.connected_components_map {β : Type*} [topological_space β] {f : α → β}
  (h : continuous f) : connected_components α → connected_components β :=
continuous.connected_components_lift (continuous_quotient_mk.comp h)

lemma continuous.connected_components_map_continuous {β : Type*} [topological_space β] {f : α → β}
  (h : continuous f) : continuous h.connected_components_map :=
continuous.connected_components_lift_continuous (continuous_quotient_mk.comp h)

end connected_component_setoid


import set_theory.cardinal
import linear_algebra.dimension

universes u v

namespace finsupp

open finset

--finsupp or fintype
def equiv_fun {α : Type u} {β : Type v} [decidable_eq α] [has_zero α] [h : fintype β] :
(β →₀ α) ≃ (β → α) :=
{ to_fun := finsupp.to_fun,
  inv_fun := λ f, finsupp.mk (finset.filter (λ a, f a ≠ 0) h.elems) f
    (assume a, by rw[mem_filter]; exact and_iff_right (fintype.complete a)),
  left_inv := λ f, finsupp.ext (λ _, rfl),
  right_inv := λ f, rfl }

variables {α : Type u} {β : Type v}
variables [decidable_eq α]
variables [decidable_eq β] [add_comm_group β]

variable (s : finset α)

--with map_domain
lemma map_domain_apply {α₁ α₂ : Type*} [decidable_eq α₁] [decidable_eq α₂]
(v : α₁ → α₂) (f : α₁ →₀ β) (h : function.injective v) {a : α₁} :
(map_domain v f) (v a) = f a := show (f.sum $ λ x, single (v x)) (v a) = f a,
begin
  rw[←sum_single f],
  simp,
  apply sum_congr, refl,
  intros,
  simp[single_apply, function.injective.eq_iff h],
  congr
end

--subtype_domain
lemma subtype_domain_left_inv (p : α → Prop) [d : decidable_pred p] (f : α →₀ β) (h : ∀ a ∈ f.support, p a) :
map_domain subtype.val (subtype_domain p f) = f :=
finsupp.ext $ λ a, match d a with
| is_true  (hp : p a)  := by rw[←subtype.coe_mk _ hp];
  exact map_domain_apply _ _ subtype.val_injective
| is_false (hp : ¬p a) :=
  have a ∉ f.support, from mt (h a) hp,
  have h0 : f a = 0, from of_not_not $ mt ((f.mem_support_to_fun a).mpr) this,
  begin
    rw[h0],
    apply (not_mem_support_iff).mp,
    apply mt (mem_of_subset map_domain_support),
    simp,
    assume x _ hfx hxa,
    exact absurd h0 (hxa ▸ hfx)
  end
end

--subtype domain
lemma subtype_domain_right_inv (p : α → Prop) [decidable_pred p] (f : subtype p →₀ β) :
subtype_domain p (map_domain subtype.val f) = f :=
finsupp.ext $ λ a, map_domain_apply _ _ (subtype.val_injective)

--lc ?
def equiv_lc [ring α] [module α β] {s : set β} [decidable_pred s] :
(s →₀ α) ≃ lc.supported s :=
{ to_fun := λ f, ⟨map_domain subtype.val f,
    assume a h,
    have h0 : a ∈ image _ _, from mem_of_subset map_domain_support h,
    let ⟨ap, _, hs⟩ := mem_image.mp h0 in hs ▸ ap.property⟩,
  inv_fun := (finsupp.subtype_domain s) ∘ subtype.val,
  left_inv := subtype_domain_right_inv _,
  right_inv := λ f, subtype.eq $ subtype_domain_left_inv _ f.val f.property }

end finsupp

namespace module

variables {α : Type u} {β : Type v}
variables [ring α] [decidable_eq α]
variables [add_comm_group β] [module α β] [decidable_eq β]
variables {b : set β}

include α β

--basis.lean
noncomputable def equiv_finsupp_basis [decidable_pred b] (h : is_basis b) : β ≃ (b →₀ α) :=
calc β ≃ lc.supported b : (module_equiv_lc h).to_equiv
   ... ≃ (b →₀ α)       : equiv.symm finsupp.equiv_lc

--basis.lean
noncomputable def equiv_fun_basis [decidable_pred b] [fintype b] (h : is_basis b) : β ≃ (b → α) :=
calc β ≃ (b →₀ α) : equiv_finsupp_basis h
   ... ≃ (b → α)  : finsupp.equiv_fun

end module

namespace vector_space

open fintype module

variables (α : Type u) (β : Type v)
variables [discrete_field α] [fintype α]
variables [add_comm_group β] [fintype β]
variables [vector_space α β]

--vector_space
lemma card_fin [deβ : decidable_eq β] : ∃ n : ℕ, card β = (card α) ^ n :=
let ⟨b, hb⟩ := exists_is_basis β in
begin
haveI : fintype b := set.finite.fintype (set.finite.of_fintype b),
haveI : decidable_pred b := set.decidable_mem_of_fintype b,
exact ⟨card b,
  calc card β = card (b → α)    : card_congr (equiv_fun_basis hb)
          ... = card α ^ card b : card_fun⟩
end

end vector_space


/-
Copyright (c) 2019 Patrick Massot All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Patrick Massot, Simon Hudon

A tactic pushing negations into an expression
-/

import tactic.interactive
import algebra.order
import tactic.push_neg

open tactic expr

namespace push_neg
open push_neg
section

universe u
variable  {α : Sort u}
variables (p q : Prop)
variable  (s : α → Prop)

local attribute [instance, priority 10] classical.prop_decidable
-- theorem not_not_eq : (¬ ¬ p) = p := propext not_not
-- theorem not_and_eq : (¬ (p ∧ q)) = (¬ p ∨ ¬ q) := propext not_and_distrib
-- theorem not_or_eq : (¬ (p ∨ q)) = (¬ p ∧ ¬ q) := propext not_or_distrib
-- theorem not_forall_eq : (¬ ∀ x, s x) = (∃ x, ¬ s x) := propext not_forall
-- theorem not_exists_eq : (¬ ∃ x, s x) = (∀ x, ¬ s x) := propext not_exists
-- theorem not_implies_eq : (¬ (p → q)) = (p ∧ ¬ q) := propext not_imp

-- theorem classical.implies_iff_not_or : (p → q) ↔ (¬ p ∨ q) := imp_iff_not_or

-- theorem not_eq (a b : α) : (¬ a = b) ↔ (a ≠ b) := iff.rfl

variable  {β : Type u}
variable [linear_order β]
-- theorem not_le_eq (a b : β) : (¬ (a ≤ b)) = (b < a) := propext not_le
-- theorem not_lt_eq (a b : β) : (¬ (a < b)) = (b ≤ a) := propext not_lt
end

-- meta def whnf_reducible (e : expr) : tactic expr := whnf e reducible

private meta def transform_negation_step (e : expr) :
  tactic (option (expr × expr)) :=
do e ← whnf_reducible e,
   match e with
   | `(¬ %%ne) :=
      (do ne ← whnf_reducible ne,
      match ne with
      | `(¬ %%a)      := do pr ← mk_app ``not_not_eq [a],
                            return (some (a, pr))
      | `(%%a ∧ %%b)  := do pr ← mk_app ``not_and_eq [a, b],
                            return (some (`(¬ %%a ∨ ¬ %%b), pr))
      | `(%%a ∨ %%b)  := do pr ← mk_app ``not_or_eq [a, b],
                            return (some (`(¬ %%a ∧ ¬ %%b), pr))
      | `(%%a ≤ %%b)  := do e ← to_expr ``(%%b < %%a),
                            pr ← mk_app ``not_le_eq [a, b],
                            return (some (e, pr))
      | `(%%a < %%b)  := do e ← to_expr ``(%%b ≤ %%a),
                            pr ← mk_app ``not_lt_eq [a, b],
                            return (some (e, pr))
      | `(Exists %%p) := do pr ← mk_app ``not_exists_eq [p],
                            e ← match p with
                                | (lam n bi typ bo) := do
                                    body ← mk_app ``not [bo],
                                    return (pi n bi typ body)
                                | _ := tactic.fail "Unexpected failure negating ∃"
                                end,
                            return (some (e, pr))
      | (pi n bi d p) := if p.has_var then do
                            pr ← mk_app ``not_forall_eq [lam n bi d p],
                            body ← mk_app ``not [p],
                            e ←  mk_app ``Exists [lam n bi d body],
                            return (some (e, pr))
                         else do
                            pr ← mk_app ``not_implies_eq [d, p],
                            `(%%_ = %%e') ← infer_type pr,
                            return (some (e', pr))
      | _             := return none
      end)
    | _        := return none
  end

private meta def transform_negation : expr → tactic (option (expr × expr))
| e :=
do (some (e', pr)) ← transform_negation_step e | return none,
   (some (e'', pr')) ← transform_negation e' | return (some (e', pr)),
   pr'' ← mk_eq_trans pr pr',
   return (some (e'', pr''))

meta def normalize_negations_1 (t : expr) : tactic (expr × expr) :=
do (_, e, pr) ← simplify_top_down ()
                   (λ _, λ e, do
                       oepr ← transform_negation_step e,
                       match oepr with
                       | (some (e', pr)) := return ((), e', pr)
                       | none            := do pr ← mk_eq_refl e, return ((), e, pr)
                       end)
                   t { eta := ff },
   return (e, pr)

meta def push_neg_1_at_hyp (h : name) : tactic unit :=
do H ← get_local h,
   t ← infer_type H,
   (e, pr) ← normalize_negations_1 t,
   replace_hyp H e pr,
   skip

meta def push_neg_1_at_goal : tactic unit :=
do H ← target,
   (e, pr) ← normalize_negations_1 H,
   replace_target e pr
end push_neg

open interactive (parse loc.ns loc.wildcard)
open interactive.types (location texpr)
open lean.parser (tk ident many) interactive.loc
local postfix `?`:9001 := optional
local postfix *:9001 := many
open push_neg

/--
Push negations in the goal of some assumption.

For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variables names are conserved.

This tactic pushes negations inside expressions. For instance, given an assumption
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```

(the pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).
Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every assumption and the goal using `push_neg at *` or at selected assumptions and the goal
using say `push_neg at h h' ⊢` as usual.
-/
meta def tactic.interactive.push_neg_1 : parse location → tactic unit
| (loc.ns loc_l) := loc_l.mmap'
                      (λ l, match l with
                            | some h := do push_neg_1_at_hyp h,
                                            try `[simp only [push_neg.not_eq] at h { eta := ff }]
                            | none   := do push_neg_1_at_goal,
                                            try `[simp only [push_neg.not_eq] { eta := ff }]
                            end)
| loc.wildcard := do
    push_neg_1_at_goal,
    local_context >>= mmap' (λ h, push_neg_1_at_hyp (local_pp_name h)) ,
    try `[simp only [push_neg.not_eq] at * { eta := ff }]


import .refactor_iterate logic.relator .transfer_mathlib

def fmatrix (m n : ℕ) := array m (array n ℚ)

variables {m n : ℕ}

namespace matrix

def read (A : matrix (fin m) (fin n) ℚ) (i : fin m) (j : fin n) : ℚ := A i j

def write (A : matrix (fin m) (fin n) ℚ) (i : fin m) (j : fin n) (a : ℚ) :=
λ i' j', if i' = i ∧ j'  = j then a else A.read i j

@[irreducible] def of_fun (A : fin m → fin n → ℚ) := A

def zero : matrix (fin m) (fin n) ℚ := 0

end matrix

namespace tableau

def pivot' : Π (T : tableau m n) (r : fin m) (c : fin n), tableau m n :=
λ T r c,
let p := (T.to_matrix.read r c)⁻¹ in
{ to_matrix := matrix.of_fun (λ i j,
    if i = r
      then if j = c
        then p
        else -T.to_matrix.read r j * p
      else if j = c
        then T.to_matrix.read i c * p
        else T.to_matrix.read i j - T.to_matrix.read i c * T.to_matrix.read r j * p),
  to_partition := T.to_partition.swap r c,
  offset := matrix.of_fun $ λ i k,
    if i = r
      then -T.offset.read r k * p
      else T.offset.read i k - T.to_matrix.read i c * T.offset.read r k * p,
  restricted := T.restricted }

end tableau

namespace equiv
variables {α : Sort*} {β : Sort*}

def rel (e : α ≃ β) (a : α) (b : β) : Prop := e a = b

end equiv

namespace fmatrix

def read (A : fmatrix m n) (i : fin m) (j : fin n) : ℚ :=
(array.read A i).read j

def to_matrix (A : fmatrix m n) : matrix (fin m) (fin n) ℚ := sorry

def zero : fmatrix m n := sorry

/-- maybe this can be replaced with matrix.to_fmatrix -/
@[irreducible] def of_fun (A : fin m → fin n → ℚ) : fmatrix m n :=
sorry

end fmatrix

def matrix.to_fmatrix (A : fin m → fin n → ℚ) : fmatrix m n := sorry

def equiv_matrix : matrix (fin m) (fin n) ℚ ≃ fmatrix m n :=
{ to_fun := matrix.to_fmatrix,
  inv_fun := fmatrix.to_matrix,
  left_inv := sorry,
  right_inv := sorry }

#check ((@equiv_matrix m n).rel ⇒ (eq : Π a b : fin n, Prop) )
#where
lemma read_rel :
  ((@equiv_matrix m n).rel ⇒ eq ⇒ eq ⇒ eq) matrix.read fmatrix.read := sorry

lemma eq_to_equiv_matrix.rel : ((eq ⇒ eq ⇒ eq) ⇒
  (@equiv_matrix m n).rel) matrix.of_fun fmatrix.of_fun := sorry

lemma equiv_matrix_rel : ((@equiv_matrix m n).rel ⇒ (@equiv_matrix m n).rel ⇒ iff) eq eq := sorry

lemma zero_rel : (@equiv_matrix m n).rel matrix.zero fmatrix.zero := sorry

#print array
open fmatrix

structure ftableau (m n : ℕ) :=
(to_fmatrix : fmatrix m n)
(offset : fmatrix m 1)
(to_partition : partition m n)
(restricted : finset (fin (m + n)))

def equiv_tableau : tableau m n ≃ ftableau m n :=
{ to_fun := λ ⟨M, O, P, R⟩, ⟨equiv_matrix.to_fun M, equiv_matrix.to_fun O, P, R⟩,
  inv_fun := λ ⟨M, O, P, R⟩, ⟨equiv_matrix.inv_fun M, equiv_matrix.inv_fun O, P, R⟩,
  left_inv := sorry,
  right_inv := sorry }

lemma to_matrix_rel : ((@equiv_tableau m n).rel ⇒ equiv_matrix.rel)
  tableau.to_matrix ftableau.to_fmatrix := sorry

lemma offset_rel : ((@equiv_tableau m n).rel ⇒ (@equiv_matrix m 1).rel)
  tableau.offset ftableau.offset := sorry

lemma to_partition_rel : ((@equiv_tableau m n).rel ⇒ eq)
  tableau.to_partition ftableau.to_partition := sorry

lemma restricted_rel : ((@equiv_tableau m n).rel ⇒ eq)
  tableau.restricted ftableau.restricted := sorry

lemma mk_rel : ((@equiv_matrix m n).rel ⇒ (@equiv_matrix m 1).rel ⇒ eq ⇒ eq ⇒
  (@equiv_tableau m n).rel) tableau.mk ftableau.mk := sorry

lemma equiv_tableau_rel : ((@equiv_tableau m n).rel ⇒ (@equiv_tableau m n).rel ⇒ iff) eq eq := sorry

namespace ftableau

def pivot' : Π (T : ftableau m n) (r : fin m) (c : fin n), ftableau m n :=
λ T r c,
let p := (T.to_fmatrix.read r c)⁻¹ in
{ to_fmatrix := matrix.to_fmatrix (λ i j,
    if i = r
      then if j = c
        then p
        else -T.to_fmatrix.read r j * p
      else if j = c
        then T.to_fmatrix.read i c * p
        else T.to_fmatrix.read i j - T.to_fmatrix.read i c * T.to_fmatrix.read r j * p),
  to_partition := T.to_partition.swap r c,
  offset := matrix.to_fmatrix $ λ i k,
    if i = r
      then -T.offset.read r k * p
      else T.offset.read i k - T.to_fmatrix.read i c * T.offset.read r k * p,
  restricted := T.restricted }

end ftableau
#where
#print read_rel
#print has_to_tactic_format
#print list.to_string

attribute [irreducible] matrix.read matrix.of_fun matrix.zero
  tableau.to_matrix tableau.offset tableau.to_partition tableau.restricted
  -- ftableau.to_matrix tableau.offset tableau.to_partition tableau.restricted tableau.mk

lemma fin_zero_rel {n : ℕ} : (0 : fin (n + 1)) = 0 := rfl

instance bi_total_equiv {α β} (e : α ≃ β) : relator.bi_total e.rel := sorry
-- lemma fin_zero_rel {n : ℕ} : (0 : fin (n + 1)) = 0

lemma equiv_matrix_rel2 : (eq ⇒ eq ⇒ iff) (@equiv_matrix m n).rel equiv_matrix.rel := sorry

lemma tableau_equiv_rel2 : (eq ⇒ eq ⇒ iff) (@equiv_tableau m n).rel equiv_tableau.rel

run_cmd do rds ← transfer.analyse_decls
  [ ``read_rel,``zero_rel, ``fin_zero_rel],
    rds_fmt ← rds.mmap has_to_tactic_format.to_tactic_format,
    tactic.trace (((rds_fmt.map to_string).intersperse "; ").to_string),
  transfer.compute_transfer rds [] `((eq (@matrix.read 3 2 (matrix.zero) 0 0)))
#print rel_forall_of_total
lemma pivot_rel :
  (equiv_tableau.rel ⇒ eq ⇒ eq ⇒ equiv_tableau.rel) (@tableau.pivot' m n) ftableau.pivot' :=
begin
  dunfold tableau.pivot' ftableau.pivot',
  transfer.transfer
  [``equiv_matrix_rel2, `tableau_equiv_rel2, `relator.rel_forall_of_total, `to_matrix_rel, `offset_rel, `to_partition_rel, `restricted_rel, `mk_rel,
    `read_rel, `eq_to_equiv_matrix.rel, `equiv_matrix_rel, `equiv_tableau_rel],

end

-- def pivot : { p : Π (T : ftableau m n) (r : fin m) (c : fin n), ftableau m n //
--   (equiv_tableau.rel ⇒ eq ⇒ eq ⇒ equiv_tableau.rel) tableau.pivot' p } :=
-- begin
--   dunfold tableau.pivot',
--   refine ⟨_, _⟩, swap,
--   { transfer.transfer [`to_matrix_rel, `offset_rel, `to_partition_rel, `restricted_rel, `mk_rel,
--     `read_rel, `eq_to_equiv_matrix.rel, `equiv_matrix_rel] },

-- end

end ftableau

-- open matrix fintype finset function pequiv

-- local notation `rvec`:2000 n := matrix (fin 1) (fin n) ℚ
-- local notation `cvec`:2000 m := matrix (fin m) (fin 1) ℚ
-- local infix ` ⬝ `:70 := matrix.mul
-- local postfix `ᵀ` : 1500 := transpose

-- structure tableau' (m n : ℕ) :=
-- (to_matrix : matrix (fin m) (fin n) ℚ)
-- (offset : cvec m)
-- (to_partition : partition m n)
-- (restricted : finset (fin (m + n)))