/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import order.filter.basic
import topology.bases
import data.real.nnreal
import topology.instances.real
import topology.instances.nnreal
import topology.instances.ennreal

import topology.algebra.infinite_sum
import formal_ml.set
import formal_ml.finset
import formal_ml.nat
import formal_ml.ennreal
import formal_ml.nnreal
import data.finset
import order.complete_lattice
import formal_ml.real

open finset

lemma filter_le_intro (α:Type*) (A B:filter α):
  (∀ a, a∈ B → a∈ A)→ (A≤ B)  :=
begin
  intros,
  apply (@filter.le_def α A B).mpr,
  assumption,
end

lemma filter_le_intro2 (α:Type*) (A B:filter α):
  (B.sets ⊆ A.sets)→ (A≤ B)  :=
begin
  intros,
  apply (@filter.le_def α A B).mpr,
  have A1:((B.sets ⊆ A.sets) ↔ (∀ a∈ B.sets, a∈ A.sets)),
  {
     refl,
  },
  assumption,
end

lemma filter_le_elim {α:Type*} {A B:filter α} {a:set α}:
   (A≤ B) → (a∈ B)→ (a∈ A) :=
begin
  intros,
  apply (@filter.le_def α A B).mp;assumption,
end

/-
  filter.map f A is the pre-image of the pre-image of the sets in A.
  --set.preimage f has type (set β)→ (set α)
  --set.preimage f B = {x:f x ∈ B}
  --set.preimage (set.preimage f) has type (set (set α)) → (set (set β))
  --set.preimage (set.preimage f) AF = {y:(set.preimage f) y ∈ AF}
  --set.preimage (set.preimage f) AF = {y:{x:f x∈ y} ∈ AF}

-/
lemma filter_map_def (α β:Type*) (A:filter α) (f:α → β):
  (filter.map f A).sets = set.preimage (set.preimage f) A.sets :=
begin
  refl,
end

lemma filter_mem_def (α:Type*) (A:filter α) (a:set α):
  (a∈ A) = (a ∈ A.sets) :=
begin
  refl,
end

lemma filter_map_intro (α β : Type*) (A : filter α) (f : α → β) (X : set α) (Y : set β)
 (a: X∈ A) (a_1 : X=set.preimage f Y) : (Y∈ filter.map f A)  :=
begin
  rw filter_mem_def,
  rw filter_map_def,
  unfold set.preimage,
  simp,
  rw filter_mem_def at a,
  unfold set.preimage at a_1,
  rw ← a_1,
  assumption,
end

lemma filter_map_elim (α β:Type*) (A:filter α) (f:α → β) (Y:set β)
  (a : Y ∈ filter.map f A) : (∃ (X∈ A), (X=set.preimage f Y))   :=
begin
  rw filter_mem_def at a,
  rw filter_map_def at a,
  --unfold set.preimage,
  simp,
  unfold set.preimage at a,
  simp at a,
  apply a,
end

lemma filter_tendsto_intro (α β:Type*)   (f:α → β) (A:filter α) (B:filter β):
  (∀ b∈ B, set.preimage f b ∈ A) → (@filter.tendsto α β  f A B)  :=
begin
  intros a,
  unfold filter.tendsto,
  apply filter_le_intro,
  intros a_1 a_2,
  apply filter_map_intro,
  have A1:a_1 ∈ B → f ⁻¹' a_1 ∈ A,
  {
    apply a,
  },

  have A2:f ⁻¹' a_1 ∈ A,
  {
     apply A1,
     apply a_2,
  },
  apply A2,
  refl,
end

lemma filter_tendsto_elim {α β:Type*} {f:α → β} {A:filter α} {B:filter β} {s:set β}:
   (@filter.tendsto α β  f A B) →(s∈ B)→  (set.preimage f s ∈ A) :=
begin
  intros a a_1,
  unfold filter.tendsto at a,
  have A1:s∈ filter.map f A,
  {
    apply filter_le_elim,
    apply a,
    apply a_1,
  },

  have A2:(∃ (X∈ A), (X=set.preimage f s)),
  {
    apply (filter_map_elim),
    apply A1,
  },
  cases A2,
  cases A2_h,
  subst A2_w,
  exact A2_h_w,
end

lemma filter_principal_intro {α:Type*} (a:finset α) (b:set (finset α)):
  ({c : finset α | a ⊆ c} ⊆ b) → b ∈ (filter.principal  {c:finset α | a⊆ c}):=
begin
  --apply b∈ (filter.principal  {c:finset ℕ | a⊆ c}),
  intros a_1,
  unfold filter.principal,
  have A1:b ∈ {t : set (finset α) | {c : finset α | a ⊆ c} ⊆ t},
  {
    simp,
    apply a_1,
  },
  apply A1,
end

lemma filter_principal_elim {α:Type*} (a:finset α) (b:set (finset α)):
  b ∈ (filter.principal  {c:finset α | a⊆ c}) → ({c : finset α | a ⊆ c} ⊆ b) :=
begin
  intros a_1,
  apply (@filter.mem_principal_sets (finset α) b {c:finset α | a⊆ c}).mp,
  apply a_1,
end

lemma filter_principal_intro2 {α:Type*} (a:finset α) (b:set (finset α)):
  (∀ c:finset α, a⊆ c → c∈ b) → b ∈ (filter.principal  {c:finset α | a⊆ c}):=
begin
  intros a_1,
  apply filter_principal_intro,
  rw set.subset_def,
  intros a_3 a_2,
  simp at a_2,
  apply a_1,
  apply a_2,
end

lemma filter_principal_intro3 {α:Type*} (a b:set α):
  (a⊆ b) → b ∈ filter.principal  a:=
begin
  simp [filter.principal],
end

lemma filter_principal_elim2 {α:Type*} (a:finset α) (b:set (finset α)) (c:finset α):
  b ∈ (filter.principal  {c:finset α | a⊆ c}) → (a ⊆ c) → (c∈ b) :=
begin
  intros a_1 a_2,
  apply (@filter_principal_elim α a b),
  {
    apply a_1,
  },
  apply a_2,
end

lemma filter_principal_elim3 {α:Type*} (a b:set α):
  b ∈ filter.principal  a → (a⊆ b):=
begin
  unfold filter.principal,
  simp,
end

/-
  Let's walk through a simple example.
  b={1,2}
  c={2,3}
  filter.principal {{1,2},{1,2,3},{1,2,3,4}, {1,2,4}} ⊓
  filter.principal {{1,3},{1,2,3},{1,2,3,4}, {1,3,4}} =
  filter.principal {{1,2,3}, {1,2,3,4}}
 -/

lemma principal_inf
    (α:Type*) (A B:set α):
    (filter.principal A ⊓ filter.principal B = filter.principal (A∩B)) :=
begin
  simp,
end

lemma principal_inf_sets2 {α:Type*} [semilattice_sup_bot α] (b c:α):
   filter.principal {d:α |b ≤ d} ⊓ filter.principal {d: α |c ≤ d}
   = filter.principal {d:α |(b ⊔ c) ≤ d} :=
begin
  have A1:{d:α |b ≤ d} ∩ {d:α |c ≤ d} = {d: α |(b ⊔ c) ≤ d},
  {
    ext,
    split;intros a,
    {
      cases a,
      simp at a_left,
      simp at a_right,
      simp,
      split;assumption,
    },
    {
      simp at a,
      cases a with A2 A3,
      split;simp;assumption,
    }
  },
  rw ← A1,
  apply principal_inf,
end

-- Use apply principal_inf_sets2,
lemma principal_inf_sets {α:Type*} [decidable_eq α] (b c:finset α):
   filter.principal {d:finset α |b ≤ d} ⊓ filter.principal {d:finset α |c ≤ d}
   = filter.principal {d:finset α |(b ∪ c) ≤ d} :=
begin
  apply principal_inf_sets2,
end

-- src/data/set/lattice.lean
lemma set_Inf_def (α:Type*) (S:set (set α)):
(Inf S) = {a | ∀ t ∈ S, a ∈ t } :=
begin
  refl,
end

lemma set_Inf_intro (α:Type*) (S:set (set α)) (x:α):
   (∀ X∈ S, x∈ X) → x∈ Inf S :=
begin
  intros a,
  rw set_Inf_def,
  simp,
  exact a,
end

lemma set_Inf_range_intro (α β:Type*) (f:α → set (β)) (x:β):
   (∀ y:α, x∈ f y) →  x∈ Inf (set.range  (λ (a : α), f a)) :=
begin
  intros a,
  apply set_Inf_intro,
  intros,
  unfold set.range at H,
  simp at H,
  cases H,
  rw ← H_h,
  apply a,
end

lemma glb_intro {α β:Type*} (f:α → set (β)) (x:β):
(∀ a:α, x∈ f a) → x ∈  ⨅ a, f a :=
begin
  intros a,
  unfold infi,
  unfold Inf,
  apply set_Inf_range_intro,
  assumption,
end

lemma le_Inf_simp (α:Type*) (s : set (filter α)) (a : filter α) :
    (∀ (b : filter α ), b ∈ s → a ≤ b) → a ≤ complete_lattice.Inf s :=
begin
  intros a_1,
  apply (complete_lattice.le_Inf s),
  apply a_1,
end

lemma Inf_le_simp (α : Type*)  (s : set (filter α)) (a : filter α) :
  a ∈ s → complete_lattice.Inf s ≤ a :=
begin
  intros a_1,
  apply (complete_lattice.Inf_le s),
  assumption,
end

lemma mem_Inf_intro {α : Type*}  {s : set (filter α)} {a : filter α} {t:set α}:
  t ∈ a → a ∈ s → t∈  complete_lattice.Inf s :=
begin
  intros,
  apply (complete_lattice.Inf_le s),
  assumption,
  assumption
end

-- This is equivalent to filter.mem_infi (or a mem_Inf variant of mem_infi)

def inf_filter_sets_def (α:Type*) (S : set (filter α)):set (set α) :=
  {s:set α | ∃ f∈ S, s∈ f}

lemma inf_filter_sets_of_superset2 (α:Type*) (S : set (filter α)) (s t:set α):
  s∈ (inf_filter_sets_def α S) → s⊆ t → t∈ (inf_filter_sets_def α S) :=
begin
  intro a,
  unfold inf_filter_sets_def,
  simp,
  unfold inf_filter_sets_def at a,
  simp at a,
  cases a,
  cases a_h,
  intros a_1,
  apply exists.intro a_w,
  split,
  {
    assumption,
  },
  {
    apply filter.sets_of_superset,
    apply a_h_right,
    assumption,
  }
end

--This suggests the definition is overly simplistic.
def inf_filter_sets_inter_sets2 (α:Type*) (S : set (filter α))
  (H:∀ a b:filter α, a∈ S→ b∈ S→ a⊓b∈ S)  (s t:set α):
  s∈ (inf_filter_sets_def α S) →
  t∈ (inf_filter_sets_def α S) →
  s ∩ t ∈ (inf_filter_sets_def α S) :=
begin
  unfold inf_filter_sets_def,
  simp only [and_imp, exists_prop, set.mem_set_of_eq, exists_imp_distrib],
  intros x a a_1 x_1 a_2 a_3,
  apply (exists.intro (x⊓x_1)),
  split,
  {
    apply H;assumption,
  },
  {
     simp only [filter.mem_inf_sets, ← filter_mem_def],
     have B1:(s ∩ t) ∈ x ⊓ x_1 ↔ ∃t₁∈x, ∃t₂∈x_1, t₁ ∩ t₂ ⊆ (s ∩ t),
     apply filter.mem_inf_sets,
     apply B1.mpr,
     apply exists.intro s,
     apply exists.intro a_1,
     apply exists.intro t,
     apply exists.intro a_3,
     refl,
  }
end

lemma inf_filter_univ_sets2 (α:Type*) (S : set (filter α)) (b:filter α):
  (b∈ S) → set.univ ∈ (inf_filter_sets_def α S) :=
begin
  unfold inf_filter_sets_def,
  simp,
  intros h1,
  apply exists.intro b,
  repeat {assumption},
end

def inf_filter_def2 (α:Type*) (S : set (filter α)) (b:filter α) (H:b∈ S)
  (H2:∀ a b:filter α, a∈ S→ b∈ S→ a⊓b∈ S):filter α := {
  sets := inf_filter_sets_def α S,
  sets_of_superset := inf_filter_sets_of_superset2 α S,
  univ_sets := (inf_filter_univ_sets2 α S b H),
  inter_sets := inf_filter_sets_inter_sets2 α S H2,
}

/-
  This definition is a little weak, as it assumes S is
  nonempty and closed under (binary) infimum.

  However, given these two constraints, the result is more
  elegant, and it corresponds to the generic result about
  filters, filter.eq_Inf_of_mem_sets_iff_exists_mem.
-/
lemma Inf_filter_def (α:Type*) (S : set (filter α))
(b:filter α) (H:b∈ S)
  (H2:∀ a b:filter α, a∈ S→ b∈ S→ a⊓b∈ S) (s:set α):
(s ∈ Inf S)↔ (∃ t∈ S, s∈ t) :=
begin
  have A1:(inf_filter_def2 α  S b H H2) = Inf S,
  {
     apply filter.eq_Inf_of_mem_sets_iff_exists_mem,
     intros,
     unfold inf_filter_def2,
     simp,
     unfold inf_filter_sets_def,
     simp,
  },
  rw ← A1,
  unfold inf_filter_def2,
  simp,
  unfold inf_filter_sets_def,
  simp,
end

lemma eq_Inf_of_mem_sets_iff_exists_mem {α:Type} {S : set (filter α)} {l : filter α}
  (h : ∀ {s}, s ∈ l ↔ ∃ f ∈ S, s ∈ f) : l = Inf S :=
le_antisymm (le_Inf $ λ f hf s hs, h.2 ⟨f, hf, hs⟩)
  (λ s hs, let ⟨f, hf, hs⟩ := h.1 hs in (Inf_le hf : Inf S ≤ f) hs)

--def filter_from_element (α:Type) (a:α):filter α  := filter.principal (λ a', a=a')

--filter.principal s contains all the supersets of s.
--if s is in F, then F also contains
lemma le_principal (F:filter (finset ℕ)) (s:set (finset ℕ)):
  (s∈ F)→ (F ≤ filter.principal s) :=
begin
  intros a,
  apply (filter_le_intro2 (finset ℕ) F (filter.principal s)),
  rw set.subset_def,
  intros x a_1,

  unfold filter.principal at a_1,
  simp at a_1,
  apply filter.sets_of_superset,
  {
    apply a,
  },
  {
    assumption,
  }
end

/-

What is a neighborhood of x? First, for every open set containing x,
consider the principal filter (set of all supersets). Now, let's consider the
infimum of all those settings, keeping in mind that for a set, the
inf (filter.principal S) (filter.principal T)=(filter.principal S∪T) (at this point,
we should be able to write a proof for this). Since the
union of two open sets containing X itself is an open set containing X, and every
element has at least one neighborhood that contains it, we are OK.

Thus, a neighborhood of x is a superset of an open set containing x.

--a more standard definition of neighborhood.
lemma mem_nhds_def (x:nnreal) (b:set nnreal):
  (b∈ nhds x)↔ (∃ u:set nnreal, (u⊆ b) ∧ is_open u ∧ x∈ u) :=

-/
lemma mem_nhds_elim_real_rat (b:set real) (x:real): b∈ nhds x →
(∃ p q:ℚ, (p < q) ∧ ((set.Ioo p q:set ℝ) ⊆ b) ∧ ((p:ℝ) < x) ∧ (x < (q:ℝ)))
  :=
begin
  let rat_basis := (⋃ (a b : ℚ) (h : a < b), {set.Ioo ↑a ↑b}),
  begin
  intros a,
  have A1:topological_space.is_topological_basis rat_basis,
  {
    apply real.is_topological_basis_Ioo_rat,
  },
  have A2: (b ∈ nhds x ↔ ∃ (t : set real) (H : t ∈ rat_basis), x ∈ t ∧ t ⊆ b),
  {
    apply @topological_space.mem_nhds_of_is_topological_basis,
    apply A1,
  },
  have A3: (∃ (t : set real) (H : t ∈ rat_basis), x ∈ t ∧ t ⊆ b),
  {
    apply A2.mp,
    apply a,
  },
  /-
    Now that we have proven A3, we are basically done. We just rewrite A3
    into the statement of the theorem.
  -/
  cases A3,
  cases A3_h,
  simp at A3_h_w,
  cases A3_h_w,
  cases A3_h_w_h,
  cases A3_h_w_h_h,
  subst A3_w,
  cases A3_h_h,
  apply exists.intro A3_h_w_w,
  apply exists.intro A3_h_w_h_w,
  unfold set.Ioo at A3_h_h_left,
  simp at A3_h_h_left,
  cases A3_h_h_left,
  split,
  {
    assumption,
  },
  split,
  {
    assumption,
  },
  split,
  {
    assumption,
  },
  {
    assumption,
  },
  end
end

------ Move theorems here to where they belong -----------------------------------

lemma induced_topological_basis {α β:Type*} [Tα:topological_space α]
  [Tβ:topological_space β]
  {f:α → β} {S:set (set β)}:(inducing f) →
  (topological_space.is_topological_basis S) →
  (topological_space.is_topological_basis (set.image (set.preimage f) S)) :=
begin
  intros A1 A2,
  rw A1.induced,
  unfold topological_space.is_topological_basis,
  split,
  {
    intros t₁ A3 t₂ A4 x A5,
    cases A3 with u₁ A3,
    cases A4 with u₂ A4,
    cases A5 with A6 A7,
    cases A3 with A8 A9,
    cases A4 with A10 A11,
    subst t₁,
    subst t₂,
    simp at A6,
    simp at A7,
    have A12:f x ∈ u₁ ∩ u₂,
    {
      simp,
      apply and.intro A6 A7,
    },
    unfold topological_space.is_topological_basis at A2,
    have A13 := A2.left u₁ A8 u₂ A10 (f x) A12,
    cases A13 with u₃ A13,
    cases A13 with A14 A15,
    cases A15 with A16 A17,
    apply exists.intro (f ⁻¹' u₃),
    have A18:f ⁻¹' u₃ ∈ set.preimage f '' S,
    {
      simp,
      apply exists.intro u₃,
      split,
      apply A14,
      refl,
    },
    apply exists.intro A18,
    split,
    apply A16,
    {
      rw set.subset_inter_iff at A17,
      apply set.subset_inter;apply set.preimage_mono,
      apply A17.left,
      apply A17.right,
    },
  },
  split,
  {
    ext a,split;intro A3;simp,
    unfold topological_space.is_topological_basis at A2,
    have A4:f a ∈ ⋃₀ S,
    {
      rw A2.right.left,
      simp,
    },
    cases A4 with X A5,
    cases A5 with A6 A7,
    apply exists.intro X,
    apply and.intro A6 A7,
  },
  {
    unfold topological_space.is_topological_basis at A2,
    have A3 := A2.right.right,
    rw A3,
    apply induced_generate_from_eq,
  }
end

lemma nnreal_topological_space_def:
   nnreal.topological_space = @topological_space.induced nnreal real
   (@coe nnreal real _) (@uniform_space.to_topological_space real _) := rfl

lemma inducing_nnreal_topological_space:
   inducing (@coe nnreal real _) := {
  induced := nnreal_topological_space_def,
}

lemma nnreal_nhds {x:nnreal}:
   nhds x = filter.comap (@coe nnreal real _) (nhds x.val) :=
begin
  apply inducing.nhds_eq_comap,
  apply inducing_nnreal_topological_space,
end

lemma nnreal_nhds2 {x:nnreal} {B:set nnreal}:
   B ∈ nhds x ↔
   (∃ C∈ nhds (x.val),set.preimage (@coe nnreal real _) C⊆ B)  :=
begin
  rw nnreal_nhds,
  apply filter.mem_comap_sets,
end

lemma coe_nnreal_real_val:(@coe nnreal real _) = subtype.val := rfl

lemma mem_nhds_elim_real {b:set real} {x:real}: b∈ nhds x →
(∃ p q:ℝ, (p < q) ∧ ((set.Ioo p q) ⊆ b) ∧ (p < x) ∧ (x < q))
  :=
begin
  intros a,
  have A1:(∃ prat qrat:ℚ, (prat < qrat) ∧ ((set.Ioo prat qrat:set ℝ) ⊆ b) ∧ ((prat:ℝ) < x) ∧ (x < (qrat:ℝ))),
  {
    apply mem_nhds_elim_real_rat,
    apply a,
  },
  cases A1,
  cases A1_h,
  cases A1_h_h,
  cases A1_h_h_right,
  cases A1_h_h_right_right,

  apply exists.intro (A1_w:ℝ),
  apply exists.intro (A1_h_w:ℝ),
  split,
  {
    apply (@rat.cast_lt real _ A1_w A1_h_w).mpr,
    apply A1_h_h_left,
  },
  {
    split,
    {
      assumption,
    },
    split,
    {
      apply A1_h_h_right_right_left,
    },
    {
      apply A1_h_h_right_right_right,
    }
  },
end

lemma mem_nhds_elim_nnreal {b:set nnreal} {x:nnreal}: b∈ nhds x →
(∃ p q:ℝ, (p < q) ∧
          (set.preimage  (@coe nnreal real _) (set.Ioo p q) ⊆ b) ∧
          (p < ↑x) ∧ (↑x < q))
  :=
begin
  intro A1,
  rw nnreal_nhds2 at A1,
  cases A1 with C A1,
  cases A1 with A2 A3,
  have A4 := mem_nhds_elim_real A2,
  cases A4 with p A4,
  cases A4 with q A4,
  cases A4 with A5 A6,
  cases A6 with A7 A8,
  --cases A8 with A9 A10,
  apply exists.intro p,
  apply exists.intro q,
  split,
  apply A5,
  split,
  apply set.subset.trans,
  {
    apply set.preimage_mono,
    apply A7,
  },
  {
    apply A3,
  },
  apply A8,
end

lemma preimage_coe_Ioo {p q:ℝ}:(p < 0) → (0 ≤ q) →
    set.preimage (@coe nnreal real _) (set.Ioo p q) = set.Iio (nnreal.of_real q) :=
begin
  intro A1,
  intro A2,
  unfold set.Ioo set.Iio,
  ext,split;intro A3;simp at A3;simp,
  {
    cases A3 with A4 A5,
    rw ← nnreal.coe_lt_coe,
    rw nnreal.coe_of_real,
    apply A5,
    apply A2,
  },
  {
    split,
    {
      apply lt_of_lt_of_le,
      apply A1,
      apply x.property,
    },
    {
      rw ← nnreal.coe_of_real q,
      rw nnreal.coe_lt_coe,
      apply A3,
      apply A2,
    },
  },
end

lemma preimage_coe_Ioo2 {p q:ℝ}:(0 ≤ p) → (p < q) →
    set.preimage (@coe nnreal real _) (set.Ioo p q) = set.Ioo (nnreal.of_real p) (nnreal.of_real q) :=
begin
  intro A1,
  intro A2,
  have B1:0 ≤ q,
  {
    apply le_trans,
    apply A1,
    apply le_of_lt,
    apply A2,
  },
  unfold set.Ioo,
  ext,split;intro A3;simp at A3;simp,
  {
    cases A3 with A4 A5,
    split;rw ← nnreal.coe_lt_coe;rw nnreal.coe_of_real,
    apply A4,
    apply A1,
    apply A5,
    apply B1,
  },
  {
    cases A3 with A4 A5,
    split,
    {
      rw ← nnreal.coe_of_real p,
      rw nnreal.coe_lt_coe,
      apply A4,
      apply A1,
    },
    {
      rw ← nnreal.coe_of_real q,
      rw nnreal.coe_lt_coe,
      apply A5,
      apply B1,
    },
  },
end

lemma mem_nhds_elim_nnreal2 {b:set nnreal} {x:nnreal}:x ≠ 0 →  b∈ nhds x →
(∃ p q:nnreal, (p < q) ∧
          ((set.Ioo p q) ⊆ b) ∧
          (p < x) ∧ (x < q))
  :=
begin
  intros A1 A2,
  have A3 := mem_nhds_elim_nnreal A2,
  cases A3 with p A3,
  cases A3 with q A3,
  cases A3 with A4 A5,
  cases A5 with A6 A7,
  cases A7 with A8 A9,
  have A10:p < 0 ∨ 0 ≤ p := lt_or_le p 0,
  have A11:0 < x := bot_lt_iff_ne_bot.mpr A1,
  have A12:(@coe nnreal real _ 0) = (0:real) := rfl,
  have A13:x.val = (@coe nnreal real _ x) := rfl,
  have A14:0 < x.val,
  {
    rw A13,
    rw ← A12,
    rw nnreal.coe_lt_coe,
    apply A11,
  },
  have A15:0 ≤ q,
  {
    apply le_trans,
    apply x.property,
    apply le_of_lt,
    apply A9,
  },
  have A16:x < nnreal.of_real q,
  {
    rw ← nnreal.coe_lt_coe,
    rw nnreal.coe_of_real,
    apply A9,
    apply A15,
  },
  cases A10,
  {
    apply exists.intro (0:nnreal),
    apply exists.intro (nnreal.of_real q),
    split,
    {
      rw ← nnreal.coe_lt_coe,
      rw A12,
      apply lt_trans,
      apply A14,
      rw A13,
      apply lt_of_lt_of_le,
      apply A9,
      rw nnreal.coe_of_real,
      apply A15,
    },
    split,
    {
      have B2:set.Ioo 0 (nnreal.of_real q) ⊆
              (set.preimage (@coe nnreal real _) (set.Ioo p q)),
      {
        rw preimage_coe_Ioo,
        rw set.subset_def,
        intros y B2A,
        unfold set.Iio,
        unfold set.Ioo at B2A,
        simp at B2A,
        simp,
        apply B2A.right,
        apply A10,
        apply A15,
      },
      apply set.subset.trans B2 A6,
    },
    split,
    {
      apply A11,
    },
    {
      apply A16,
    },
  },
  {
    apply exists.intro (nnreal.of_real p),
    apply exists.intro (nnreal.of_real q),
    have B1:nnreal.of_real p < x,
    {
      rw ← nnreal.coe_lt_coe,
      rw nnreal.coe_of_real,
      apply A8,
      apply A10,
    },
    split,
    {
      apply lt_trans B1 A16,
    },
    split,
    {
      rw ← preimage_coe_Ioo2,
      apply A6,
      apply A10,
      apply A4,
    },
    split,
    {
      apply B1,
    },
    {
      apply A16,
    },
  },
end

lemma mem_nhds_elim_real_bound (b:set real) (x:real): b∈ nhds x →
(∃ r>0, (set.Ioo (x-r) (x+r)) ⊆ b)
  :=
begin
  intros a,
  have A1:(∃ p q:ℝ, (p < q) ∧ ((set.Ioo p q) ⊆ b) ∧ (p < x) ∧ (x < q)),
  {
    apply mem_nhds_elim_real,
    apply a,
  },
  cases A1,
  cases A1_h,
  cases A1_h_h,
  cases A1_h_h_right,
  cases A1_h_h_right_right,

  let r := min (x - A1_w) (A1_h_w -x),
  begin
  apply exists.intro r,
  have A2:r>0,
  {
    apply lt_min,
    {
       apply (@lt_sub real _ 0 x A1_w).mpr,
       simp,
       assumption,
    },
    {
       apply (@lt_sub real _ 0 A1_h_w x).mpr,
       simp,
       assumption,
    }
  },
  apply exists.intro A2,
  have A3:set.Ioo (x-r) (x+r) ⊆ set.Ioo A1_w A1_h_w,
  {
    unfold set.Ioo,
    simp,
    intros a_1 a_2 a_3,
    split,
    {
      apply lt_of_le_of_lt,
      show x - r < a_1,
      {
        assumption,
      },
      {
        have A4:r <= x - A1_w,
        apply min_le_left,
        apply (@le_sub real _ r x A1_w).mp,
        assumption,
      }
    },
    {
      apply lt_of_lt_of_le,
      {
        apply a_3,
      },
      { -- prove x + r ≤ A1_h_w
        have A6:r <= A1_h_w - x,
        apply min_le_right,
        --rw A7,
        apply (@le_neg_add_iff_add_le real _ x r A1_h_w).mp,
        have A7:((-x)+A1_h_w=A1_h_w-x),
        {
          apply real.linear_ordered_comm_ring.add_comm,
        },
        rw A7,
        assumption,
      }
    },
  },
  apply set.subset.trans,
  apply A3,
  assumption,
  end
end

lemma nnreal_sub_le_sub_of_le2 {a b c:nnreal}:a ≤ b → a - c ≤ b - c :=
begin
  intro A1,
  have A2:(c ≤ a) ∨ (a ≤ c) := le_total c a,
  cases A2,
  {
    rw ← add_le_add_iff_right c,
    rw nnreal.sub_add_cancel_of_le A2,
    rw nnreal.sub_add_cancel_of_le (le_trans A2 A1),
    apply A1,
  },
  {
    rw nnreal.sub_eq_zero A2,
    apply bot_le,
  },
end

lemma nnreal_le_sub_of_le_sub_of_le {p x r:nnreal}:p ≤ x → r ≤ x - p → p ≤ x - r :=
begin
  intros A1 A2,
  rw ← add_le_add_iff_right p at A2,
  rw nnreal.sub_add_cancel_of_le A1 at A2,
  have A3:(r + p) - r ≤ x - r := nnreal_sub_le_sub_of_le2 A2,
  rw add_comm r p at A3,
  rw nnreal.add_sub_cancel at A3,
  apply A3,
end

--TODO: remove dependence on x≠0
lemma mem_nhds_elim_nnreal_bound (b:set nnreal) (x:nnreal):x ≠ 0 →  b∈ nhds x →
(∃ r>0, (set.Ioo (x-r) (x+r)) ⊆ b)
  :=
begin
  intros AX a,
  have A1:(∃ p q:nnreal, (p < q) ∧ ((set.Ioo p q) ⊆ b) ∧ (p < x) ∧ (x < q)),
  {
    apply mem_nhds_elim_nnreal2,
    apply AX,
    apply a,
  },
  cases A1 with p A1,
  cases A1 with q A1,
  cases A1 with B1 B2,
  cases B2 with B2 B3,
  cases B3 with B3 B4,

  let r := min (x - p) (q -x),
  begin
  apply exists.intro r,
  have A2:r>0,
  {
    apply lt_min;rw nnreal.sub_pos,
    {
       apply B3,
    },
    {
       apply B4,
    }
  },
  apply exists.intro A2,
  have A3:set.Ioo (x-r) (x+r) ⊆ set.Ioo p q,
  {
    apply set.Ioo_subset_Ioo,
    {
      have A4:r <= x - p := min_le_left (x-p) (q - x),
      apply nnreal_le_sub_of_le_sub_of_le (le_of_lt B3) A4,
    },
    {
      have A4:r <= q - x := min_le_right (x-p) (q - x),
      rw ← add_le_add_iff_left x at A4,
      apply le_trans A4,
      rw add_comm x,
      rw nnreal.sub_add_cancel_of_le (le_of_lt B4),
    },
  },
  apply set.subset.trans,
  apply A3,
  assumption,
  end
end

--This is filter.at_top_def
lemma filter_at_top_def3 {α:Type*} [preorder α]:
filter.at_top = ⨅ a:α, filter.principal {b | a ≤ b} := rfl

lemma filter_at_top_def (α:Type*):
  (@filter.at_top (finset α) _)=  ⨅ (a:(finset α)),
   filter.principal  {b:finset α | a⊆  b} := rfl

--This is (roughly) filter.at_top_mem_sets
lemma mem_filter_at_top_def2 {α:Type*}  [SL:semilattice_sup_bot α] {S:set α}:
  (S∈ @filter.at_top α _)↔
  (∃ a:α, {b:α|a ≤ b}⊆ S) :=
begin
  have B1:order_bot α := semilattice_sup_bot.to_order_bot α,
  have B2:has_bot α := order_bot.to_has_bot α,
  rw filter_at_top_def3,
  unfold infi,
  have A1:(∀ X Y:filter α,
  X ∈ (set.range (λ (a :α), filter.principal {b : α | a ≤ b})) →
  Y ∈ (set.range (λ (a : α), filter.principal {b : α | a ≤ b})) →
  X ⊓ Y ∈ (set.range (λ (a : α), filter.principal {b : α | a ≤ b}))),
  {
    intros X Y a a_1,
    simp at a,
    cases a,
    subst X,
    simp at a_1,
    cases a_1,
    subst Y,
    --simp,
    apply exists.intro (a_w ⊔ a_1_w),
    symmetry,
    apply principal_inf_sets2,
  },
  have A2:filter.principal {b : α | ⊥ ≤  b} ∈
   (set.range (λ (a : α), filter.principal {b : α | a ≤ b})),
  {
    rw set.mem_range,
    apply exists.intro ⊥,
    refl,
  },
  have A3:(S ∈ Inf (set.range (λ (a : α), filter.principal {b :  α | a ≤ b})))↔
          (∃ t∈ (set.range (λ (a : α), filter.principal {b : α | a ≤ b})), S∈ t),
  {
    apply (@Inf_filter_def (α)
          (set.range (λ (a : α), filter.principal {b : α | a ≤ b}))
          (filter.principal {b : α | ⊥ ≤ b})
          A2
          A1
          ),
  },
  apply iff.trans,
  apply A3,
  split;intros a,
  {
    cases a,
    cases a_h,
    simp at a_h_w,
    cases a_h_w,
    apply exists.intro a_h_w_w,
    simp,
    subst a_w,
    simp at a_h_h,
    exact a_h_h,
  },
  {
    cases a,
    apply exists.intro (filter.principal  {b : α | a_w ≤ b}),
    have A4:filter.principal {b : α | a_w ≤ b} ∈
        set.range (λ (a : α), filter.principal {b : α | a ≤ b}),
    {
      simp,
    },
    apply exists.intro A4,
    apply a_h,
  }
end

lemma filter_at_top_def2 (α:Type*) [decidable_eq α] (S:set (finset α)):
  (S∈ @filter.at_top (finset α) _)↔
  (∃ a:finset α, {b:finset α|a ≤ b}⊆ S) :=
begin
  apply mem_filter_at_top_def2,
end

--See alternatives below.
lemma filter_at_top_intro {α:Type*} (b:set (finset α)) (c:finset α):
  (b∈ (filter.principal {d:finset α |c ≤ d} )) →
  (b ∈ (@filter.at_top (finset α) _)) :=
begin
  intros,
  rw filter_at_top_def,
  unfold infi,
  apply Inf_le_simp,
  {
    have A1:(filter.principal {d:finset α |c ≤ d} ) ∈
    set.range (λ (a : finset α), filter.principal {b : finset α | a ⊆ b}),
    {
      unfold set.range,
      simp,
    },
    apply A1,
  },
  {
    assumption,
  }
end

lemma filter_at_top_elim {α:Type*} [decidable_eq α] {S:set (finset α)} :
  (S ∈ (@filter.at_top (finset α) _))→
  (∃ a:(finset α), {b:finset α|a ≤ b}⊆ S) :=
begin
  apply (filter_at_top_def2 α S).mp,
end

lemma filter_at_top_intro2 {α:Type*} (b:set (finset α)) (c:finset α):
  ({d:finset α |c ≤ d} ⊆ b) →
  (b ∈ (@filter.at_top (finset α) _)) :=
begin
  intros a,
  have A1:b∈ filter.principal {d:finset α |c ≤ d},
  {
    unfold filter.principal,
    simp,
    apply a,
  },
  apply filter_at_top_intro,
  apply A1,
end

lemma filter_contains_preimage_superset (α β:Type) (B:filter β) (S T:set α) (f:β  → α):
  (S⊆ T)→ ({x:β |f x ∈ S}∈ B) → ({x:β |f x ∈ T}∈ B) :=
begin
  intros a a_1,
  have A1:{x:β |f x ∈ S} ⊆ {x:β |f x ∈ T},
  {
    apply set.preimage_mono,
    assumption,
  },
  apply B.sets_of_superset,
  apply a_1,
  assumption,
end

lemma filter_at_top_intro3  {α β:Type*} (c:finset α) (S:set β) (f:finset α → β):
  (∀ d ≥ c, f d ∈ S) →
  ({x:finset α|f x∈ S} ∈ (@filter.at_top (finset α) _)) :=
begin
  intros a,
  have A1:({d:finset α |c ≤ d} ⊆ {x:finset α|f x∈ S}),
  {
    rw set.subset_def,
    intros x a_1,
    simp,
    simp at a_1,
    apply a,
    apply a_1,
  },
  apply filter_at_top_intro2,
  apply A1,
end

lemma mem_filter_at_top_intro {α:Type*} [P:semilattice_sup_bot α] {S:set α} {x:α}:
  {y|x≤ y}⊆ S →
  S∈ (@filter.at_top α _) :=
begin
  intro A1,
  rw mem_filter_at_top_def2,
  apply exists.intro x,
  apply A1,
end

lemma mem_filter_at_top_elim {α:Type*} [P:semilattice_sup_bot α] {S:set α} :
  (S ∈ (@filter.at_top α _))→
  (∃ a:α, {b:α|a ≤ b}⊆ S) :=
begin
  apply (mem_filter_at_top_def2).mp,
end

lemma in_own_Ioo {x ε:ℝ}:(0 < ε)→ x ∈ set.Ioo (x -ε) (x + ε) :=
begin
  apply x_in_Ioo,
end

/-
  Unused.
-/
lemma mem_nhds_elim_helper (b:set nnreal) (x:nnreal) (s:set nnreal)
  (H2 : s ∈ {s : set nnreal | x ∈ s ∧ is_open s}):
 (set.range (λ (H : s ∈ {s : set nnreal | x ∈ s ∧ is_open s}), filter.principal s))
 = {x:filter nnreal| x=filter.principal s}
  :=
begin
  unfold set.range,
  simp,
  ext,
  split,
  {
    simp,
    intros a a_1 a_2,
    symmetry,
    exact a_2,
  },
  {
    simp,
    intros a,
    split,
    {
      apply H2,
    },
    {
      symmetry,
      assumption,
    }
  }
end

lemma lim_Inf_filter_empty (α:Type*):
  (@Inf (filter α) _ ∅) = ⊤ :=
begin
  simp,
end

lemma set_in_lattice_infih (α:Type*) (s:set α) (S:set (set α))
  (H2 : s ∉ S):
 (set.range (λ (H : s ∈ S), filter.principal s)) = ∅
  :=
begin
  unfold set.range,
  simp,
  rw set.eq_empty_iff_forall_not_mem,
  intros F,
  simp,
  intros B1 B2,
  apply H2,
  apply B1
end

lemma set_in_lattice_infih2 (α:Type*) (s:set α) (S:set (set α))
  (H2 : s ∈ S):
 (set.range (λ (H : s ∈ S), filter.principal s))
 = {filter.principal s}
  :=
begin
  unfold set.range,
  simp,
  ext,
  split,
  {
    simp,
    intros a a_1,
    symmetry,
    exact a_1,
  },
  {
    simp,
    intros a,
    split,
    {
      apply H2,
    },
    {
      symmetry,
      exact a,
    }
  }
end

lemma lower_bounds_top (α:Type*) (S:set (filter α)):lower_bounds S = lower_bounds (S ∪ {⊤}) :=
begin
  ext,
  unfold lower_bounds,
  split;intros a;
   simp only [true_and, set.mem_insert_iff, forall_eq_or_imp, le_top, set.mem_set_of_eq, set.union_singleton];
  simp only [true_and, set.mem_insert_iff, forall_eq_or_imp, le_top, set.mem_set_of_eq,
             set.union_singleton] at a;intros;
  {
    apply a,
    assumption,
  },
end

lemma Inf_union_top (α:Type*) (S:set (filter α)):
Inf (S∪ {⊤}) = Inf S :=
begin
  have A2:is_glb S (Inf S),
  {
    apply is_glb_Inf,
  },
  have A3:is_glb (S∪ {⊤}) (Inf S),
  {
    cases A2,
    split,
    {
      rw ← lower_bounds_top,
      exact A2_left,
    },
    {
      rw ← lower_bounds_top,
      exact A2_right,
    }
  },
  apply is_glb.Inf_eq A3,
end

/-
  If we unfold infi in nhds, we get a doubly-nested Infimum that is hard to
  work with. This rewrites it more simply.
 -/
lemma set_in_lattice_infi (α:Type*) (S:set (set α)):
(⨅ (s∈ S), (filter.principal s)) = Inf  (set.image (filter.principal) S) :=
begin
  unfold infi,
  rw ← (@set.image_union_image_compl_eq_range (set α) _ S),
  have A1:(λ (s : set α), Inf (set.range (λ (H : s ∈ S), filter.principal s))) '' (S)ᶜ =
    (λ (s : set α), ⊤) '' Sᶜ,
  {
    rw set.image_congr,
    intros,
    have A1AA:set.range (λ (H : a ∈ S), filter.principal a) = ∅,
    {
      apply set_in_lattice_infih,
      apply H,
    },
    rw A1AA,
    rw lim_Inf_filter_empty,
  },
  rw A1,
  have A2:(λ (s : set α), Inf (set.range (λ (H : s ∈ S), filter.principal s))) '' (S) =
    (λ (s : set α), filter.principal s) '' S,
  {
    rw set.image_congr,
    intros,
    have A2A:set.range (λ (H : a ∈ S), filter.principal a) = {filter.principal a},
    {
      apply set_in_lattice_infih2,
      apply H,
    },
    rw A2A,
    simp,
  },
  rw A2,

  have A4:(Sᶜ = ∅)∨ set.nonempty Sᶜ,
  {
    apply set.eq_empty_or_nonempty,
  },
  cases A4,
  {
    rw A4,
    simp,
  },
  {
    rw set.nonempty_def at A4,
    cases A4,
    have A4A:∀ k:filter α,(λ (s : set α), k) '' Sᶜ = {k},
    {
      intros,
      ext,
      split;intros a,
      {
        cases a,
        cases a_h,
        simp at a_h_right,
        rw a_h_right,
        apply (set.mem_singleton),
      },
      {
        split,
        {
          split,
          apply A4_h,
          simp,
          simp at a,
          rw a,
        }
      }
    },
    have A4B:(λ (s : set α), ⊤) '' Sᶜ = {⊤},
    {
      apply (A4A ⊤),
    },
    rw A4B,
    apply Inf_union_top,
  }
end

lemma open_nhds_inter
    (α:Type*) [topological_space α] (x:α) (A B:set α):
    (A∈ {s:set α|x∈ s∧ is_open s}) →
    (B∈ {s:set α|x∈ s∧ is_open s}) →
    ((A∩ B) ∈ {s:set α|x∈ s∧ is_open s}) :=
begin
  intros a a_1,
  cases a,
  cases a_1,
  split,
  {
    split;assumption,
  },
  {
    apply is_open_inter;assumption,
  },
end

lemma nhds_def1 (α:Type*) [topological_space α] (x:α):
nhds x = Inf  (set.image (filter.principal) {S:set α|x∈ S ∧ is_open S}) :=
begin
  unfold nhds,
  unfold infi,
  apply set_in_lattice_infi,
end

/-
   This holds for an arbitrary topology.
   See @mem_nhds_sets_iff
 -/
lemma mem_nhds_intro_real2 {b U:set real} {x:real}:
x∈ U →
is_open U →
U ⊆ b →
b∈ nhds x :=
begin
  intros A1 A2 A3,
  rw nhds_def1,
  have A4:b∈ filter.principal U,
  {
    apply filter_principal_intro3,
    apply A3,
  },
  apply mem_Inf_intro A4,
  {
    simp,
    split;assumption,
  },
end

/- This holds for a (closed) order topology (I think) -/
lemma mem_nhds_intro_real (b:set real) (x y z:real):
x∈ set.Ioo y z →
set.Ioo y z ⊆ b →
b∈ nhds x :=
begin
  intros A1 A2,
  apply mem_nhds_intro_real2 A1 _ A2,
  apply @is_open_Ioo ℝ _ _ _ y z,
end

lemma mem_nhds_filter_principal_intro (α:Type*) [topological_space α] (x:α) (V:set α):
  V∈ {S:set α|x∈ S ∧ is_open S}→ filter.principal V ∈ (set.image (filter.principal) {S:set α|x∈ S ∧ is_open S}) :=
begin
  intros a,
  simp only [filter.principal_eq_iff_eq, set.mem_image, exists_eq_right, set.mem_set_of_eq],
  assumption,
end

lemma mem_nhds_filter_principal_elim (α:Type*) [topological_space α] (x:α) (V:set α):
  filter.principal V ∈ (set.image (filter.principal) {S:set α|x∈ S ∧ is_open S}) →
  V∈ {S:set α|x∈ S ∧ is_open S} :=
begin
  intros a,
  simp at a,
  apply a,
end

lemma mem_nhds_filter_principal_elim2 (α:Type*) [topological_space α] (x:α) (Z:filter α):
  Z ∈ (set.image (filter.principal) {S:set α|x∈ S ∧ is_open S}) →
  (∃ V:set α, V∈ {S:set α|x∈ S ∧ is_open S} ∧ filter.principal V = Z) :=
begin
  intros a,
  simp at a,
  apply a,
end

lemma has_open_neighborhood (α:Type*) [topological_space α] (x:α):∃ U:set α, x∈ U ∧ is_open U :=
begin
  apply exists.intro set.univ,
  split,
  {
    simp,
  },
  {
    apply topological_space.is_open_univ,
  }
end

lemma nhds_def2 (α:Type*) [topological_space α] (x:α) (S:set α):
S ∈ nhds x ↔
(∃ u:set α, (u⊆ S) ∧ is_open u ∧ (x∈ u)) :=
begin
  rw nhds_def1,
  have H:∃ U:set α, x∈ U ∧ is_open U,
  apply has_open_neighborhood,
  cases H,
  cases H_h,

  apply iff.trans,
  {
    apply Inf_filter_def,
    {
      apply mem_nhds_filter_principal_intro,
      simp,
      split,
      {
        apply H_h_left,
      },
      {
        apply H_h_right,
      }
    },
    {
      intros a b a_1 a_2,
      have A1:(∃ V:set α, V∈ {S:set α|x∈ S ∧ is_open S} ∧ filter.principal V = a),
      {
        apply mem_nhds_filter_principal_elim2,
        apply a_1,
      },
      cases A1,
      cases A1_h,
      subst a,
      have A2:(∃ V:set α, V∈ {S:set α|x∈ S ∧ is_open S} ∧ filter.principal V = b),
      {
        apply mem_nhds_filter_principal_elim2,
        apply a_2,
      },
      cases A2,
      cases A2_h,
      subst b,
      have A3:((A1_w ∩ A2_w) ∈ {s:set α|x∈ s∧ is_open s}),
      {
        apply open_nhds_inter;assumption,
      },
      rw principal_inf,
      split,
      {
        split,
        {
          apply A3,
        },
        {
          refl,
        }
      }
    }
  },
  {
    split;intros a,
    {
      cases a,
      cases a_h,
      have A4:(∃ V:set α, V∈ {S:set α|x∈ S ∧ is_open S} ∧ filter.principal V = a_w),
      {
        apply mem_nhds_filter_principal_elim2,
        apply a_h_w,
      },
      cases A4,
      cases A4_h,
      subst a_w,
      apply exists.intro A4_w,
      cases A4_h_left,
      split,
      {
        assumption,
      },
      split;assumption,
    },
    {
      cases a,
      cases a_h,
      cases a_h_right,
      apply exists.intro (filter.principal a_w),
      {
        have A5:filter.principal a_w ∈ filter.principal '' {S : set α | x ∈ S ∧ is_open S},
        {
          apply mem_nhds_filter_principal_intro,
          split;assumption,
        },
        apply exists.intro A5,
        apply filter_principal_intro3,
        assumption,
      }
    }
  }
end

lemma nhds_contain_point (α:Type*) [topological_space α] (x:α) (S:set α):
S ∈ nhds x → x∈ S :=
begin
  intros a,
   have A1:(∃ u:set α, (u⊆ S) ∧ is_open u ∧ (x∈ u)),
   {
     apply (nhds_def2 α x S).mp a,
   },
   cases A1,
   cases A1_h,
   rw set.subset_def at A1_h_left,
   apply A1_h_left,
   apply A1_h_right.right,
end

lemma Ioo_nbhd {x ε:ℝ}:(0 < ε)→ set.Ioo (x -ε) (x + ε) ∈ nhds x :=
begin
  intro A1,
  apply mem_nhds_intro_real,
  apply in_own_Ioo A1,
  apply set.subset.refl,
end

--Remove dependency on not equal to zero.
lemma set_Ioo_in_nhds_of_ne_zero {x:nnreal} {ε:nnreal}:x ≠ 0 → ε >0 → set.Ioo (x - ε) (x + ε) ∈ nhds x :=
begin
  intros A1 A2,
  rw @mem_nhds_sets_iff,
--  have A3:(ε≤x) ∨ (x < ε) := le_or_lt ε x,
  apply exists.intro (set.Ioo (x - ε) (x + ε)),
  split,
  apply @complete_lattice.le_refl (set nnreal) (@set.lattice_set nnreal),
  split,
  apply is_open_Ioo,
  simp,
  split,
  {
    apply nnreal.sub_lt_self,
    {
      apply bot_lt_iff_ne_bot.mpr,
      apply A1,
    },
    {
      apply A2,
    },
  },
  {
    apply A2,
  },
end

--TODO: remove dependence on x ≠ 0
lemma set_Iio_in_nhds_of_lt {x y:nnreal}:x ≠ 0 → x < y → set.Iio y ∈ nhds x :=
begin
  intros AX A1,
  rw @mem_nhds_sets_iff,
  apply exists.intro (set.Ioo 0 y),
  split,
  {
    apply set.Ioo_subset_Iio_self,
  },
  split,
  {
    apply is_open_Ioo,
  },
  simp,
  split,
  {
    apply bot_lt_iff_ne_bot.mpr,
    apply AX,
  },
  {
    apply A1,
  },
end


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton
-/
import topology.dense_embedding
import data.equiv.fin

/-!
# Homeomorphisms

This file defines homeomorphisms between two topological spaces. They are bijections with both
directions continuous. We denote homeomorphisms with the notation `≃ₜ`.

# Main definitions

* `homeomorph α β`: The type of homeomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ₜ β`.

# Main results

* Pretty much every topological property is preserved under homeomorphisms.
* `homeomorph.homeomorph_of_continuous_open`: A continuous bijection that is
  an open map is a homeomorphism.

-/

open set filter
open_locale topological_space

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Homeomorphism between `α` and `β`, also called topological isomorphism -/
@[nolint has_inhabited_instance] -- not all spaces are homeomorphic to each other
structure homeomorph (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  extends α ≃ β :=
(continuous_to_fun  : continuous to_fun . tactic.interactive.continuity')
(continuous_inv_fun : continuous inv_fun . tactic.interactive.continuity')

infix ` ≃ₜ `:25 := homeomorph

namespace homeomorph
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

instance : has_coe_to_fun (α ≃ₜ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

@[simp] lemma homeomorph_mk_coe (a : equiv α β) (b c) :
  ((homeomorph.mk a b c) : α → β) = a :=
rfl

@[simp] lemma coe_to_equiv (h : α ≃ₜ β) : ⇑h.to_equiv = h := rfl

/-- Inverse of a homeomorphism. -/
protected def symm (h : α ≃ₜ β) : β ≃ₜ α :=
{ continuous_to_fun  := h.continuous_inv_fun,
  continuous_inv_fun := h.continuous_to_fun,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ₜ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ₜ β) : β → α := h.symm

initialize_simps_projections homeomorph
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)

lemma to_equiv_injective : function.injective (to_equiv : α ≃ₜ β → α ≃ β)
| ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl

@[ext] lemma ext {h h' : α ≃ₜ β} (H : ∀ x, h x = h' x) : h = h' :=
to_equiv_injective $ equiv.ext H

/-- Identity map as a homeomorphism. -/
@[simps apply {fully_applied := ff}]
protected def refl (α : Type*) [topological_space α] : α ≃ₜ α :=
{ continuous_to_fun := continuous_id,
  continuous_inv_fun := continuous_id,
  to_equiv := equiv.refl α }

/-- Composition of two homeomorphisms. -/
protected def trans (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) : α ≃ₜ γ :=
{ continuous_to_fun  := h₂.continuous_to_fun.comp h₁.continuous_to_fun,
  continuous_inv_fun := h₁.continuous_inv_fun.comp h₂.continuous_inv_fun,
  to_equiv := equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) := rfl

@[simp] lemma homeomorph_mk_coe_symm (a : equiv α β) (b c) :
  ((homeomorph.mk a b c).symm : β → α) = a.symm :=
rfl

@[simp] lemma refl_symm : (homeomorph.refl α).symm = homeomorph.refl α := rfl

@[continuity]
protected lemma continuous (h : α ≃ₜ β) : continuous h := h.continuous_to_fun

@[continuity] -- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
protected lemma continuous_symm (h : α ≃ₜ β) : continuous (h.symm) := h.continuous_inv_fun

@[simp] lemma apply_symm_apply (h : α ≃ₜ β) (x : β) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x

@[simp] lemma symm_apply_apply (h : α ≃ₜ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

protected lemma bijective (h : α ≃ₜ β) : function.bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ₜ β) : function.injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ₜ β) : function.surjective h := h.to_equiv.surjective

/-- Change the homeomorphism `f` to make the inverse function definitionally equal to `g`. -/
def change_inv (f : α ≃ₜ β) (g : β → α) (hg : function.right_inverse g f) : α ≃ₜ β :=
have g = f.symm, from funext (λ x, calc g x = f.symm (f (g x)) : (f.left_inv (g x)).symm
                                        ... = f.symm x : by rw hg x),
{ to_fun := f,
  inv_fun := g,
  left_inv := by convert f.left_inv,
  right_inv := by convert f.right_inv,
  continuous_to_fun := f.continuous,
  continuous_inv_fun := by convert f.symm.continuous }

@[simp] lemma symm_comp_self (h : α ≃ₜ β) : ⇑h.symm ∘ ⇑h = id :=
funext h.symm_apply_apply

@[simp] lemma self_comp_symm (h : α ≃ₜ β) : ⇑h ∘ ⇑h.symm = id :=
funext h.apply_symm_apply

@[simp] lemma range_coe (h : α ≃ₜ β) : range h = univ :=
h.surjective.range_eq

lemma image_symm (h : α ≃ₜ β) : image h.symm = preimage h :=
funext h.symm.to_equiv.image_eq_preimage

lemma preimage_symm (h : α ≃ₜ β) : preimage h.symm = image h :=
(funext h.to_equiv.image_eq_preimage).symm

@[simp] lemma image_preimage (h : α ≃ₜ β) (s : set β) : h '' (h ⁻¹' s) = s :=
h.to_equiv.image_preimage s

@[simp] lemma preimage_image (h : α ≃ₜ β) (s : set α) : h ⁻¹' (h '' s) = s :=
h.to_equiv.preimage_image s

protected lemma inducing (h : α ≃ₜ β) : inducing h :=
inducing_of_inducing_compose h.continuous h.symm.continuous $
  by simp only [symm_comp_self, inducing_id]

lemma induced_eq (h : α ≃ₜ β) : topological_space.induced h ‹_› = ‹_› := h.inducing.1.symm

protected lemma quotient_map (h : α ≃ₜ β) : quotient_map h :=
quotient_map.of_quotient_map_compose h.symm.continuous h.continuous $
  by simp only [self_comp_symm, quotient_map.id]

lemma coinduced_eq (h : α ≃ₜ β) : topological_space.coinduced h ‹_› = ‹_› :=
h.quotient_map.2.symm

protected lemma embedding (h : α ≃ₜ β) : embedding h :=
⟨h.inducing, h.injective⟩

/-- Homeomorphism given an embedding. -/
noncomputable def of_embedding (f : α → β) (hf : embedding f) : α ≃ₜ (set.range f) :=
{ continuous_to_fun := continuous_subtype_mk _ hf.continuous,
  continuous_inv_fun := by simp [hf.continuous_iff, continuous_subtype_coe],
  .. equiv.of_injective f hf.inj }

protected lemma second_countable_topology [topological_space.second_countable_topology β]
  (h : α ≃ₜ β) :
  topological_space.second_countable_topology α :=
h.inducing.second_countable_topology

lemma compact_image {s : set α} (h : α ≃ₜ β) : is_compact (h '' s) ↔ is_compact s :=
h.embedding.is_compact_iff_is_compact_image.symm

lemma compact_preimage {s : set β} (h : α ≃ₜ β) : is_compact (h ⁻¹' s) ↔ is_compact s :=
by rw ← image_symm; exact h.symm.compact_image

lemma compact_space [compact_space α] (h : α ≃ₜ β) : compact_space β :=
{ compact_univ := by { rw [← image_univ_of_surjective h.surjective, h.compact_image],
    apply compact_space.compact_univ } }

lemma t2_space [t2_space α] (h : α ≃ₜ β) : t2_space β :=
{ t2 :=
  begin
    intros x y hxy,
    obtain ⟨u, v, hu, hv, hxu, hyv, huv⟩ := t2_separation (h.symm.injective.ne hxy),
    refine ⟨h.symm ⁻¹' u, h.symm ⁻¹' v,
      h.symm.continuous.is_open_preimage _ hu,
      h.symm.continuous.is_open_preimage _ hv,
      hxu, hyv, _⟩,
    rw [← preimage_inter, huv, preimage_empty],
  end }

protected lemma dense_embedding (h : α ≃ₜ β) : dense_embedding h :=
{ dense   := h.surjective.dense_range,
  .. h.embedding }

@[simp] lemma is_open_preimage (h : α ≃ₜ β) {s : set β} : is_open (h ⁻¹' s) ↔ is_open s :=
h.quotient_map.is_open_preimage

@[simp] lemma is_open_image (h : α ≃ₜ β) {s : set α} : is_open (h '' s) ↔ is_open s :=
by rw [← preimage_symm, is_open_preimage]

@[simp] lemma is_closed_preimage (h : α ≃ₜ β) {s : set β} : is_closed (h ⁻¹' s) ↔ is_closed s :=
by simp only [← is_open_compl_iff, ← preimage_compl, is_open_preimage]

@[simp] lemma is_closed_image (h : α ≃ₜ β) {s : set α} : is_closed (h '' s) ↔ is_closed s :=
by rw [← preimage_symm, is_closed_preimage]

lemma preimage_closure (h : α ≃ₜ β) (s : set β) : h ⁻¹' (closure s) = closure (h ⁻¹' s) :=
by rw [h.embedding.closure_eq_preimage_closure_image, h.image_preimage]

lemma image_closure (h : α ≃ₜ β) (s : set α) : h '' (closure s) = closure (h '' s) :=
by rw [← preimage_symm, preimage_closure]

protected lemma is_open_map (h : α ≃ₜ β) : is_open_map h := λ s, h.is_open_image.2

protected lemma is_closed_map (h : α ≃ₜ β) : is_closed_map h := λ s, h.is_closed_image.2

protected lemma open_embedding (h : α ≃ₜ β) : open_embedding h :=
open_embedding_of_embedding_open h.embedding h.is_open_map

protected lemma closed_embedding (h : α ≃ₜ β) : closed_embedding h :=
closed_embedding_of_embedding_closed h.embedding h.is_closed_map

@[simp] lemma map_nhds_eq (h : α ≃ₜ β) (x : α) : map h (𝓝 x) = 𝓝 (h x) :=
h.embedding.map_nhds_of_mem _ (by simp)

lemma symm_map_nhds_eq (h : α ≃ₜ β) (x : α) : map h.symm (𝓝 (h x)) = 𝓝 x :=
by rw [h.symm.map_nhds_eq, h.symm_apply_apply]

lemma nhds_eq_comap (h : α ≃ₜ β) (x : α) : 𝓝 x = comap h (𝓝 (h x)) :=
h.embedding.to_inducing.nhds_eq_comap x

@[simp] lemma comap_nhds_eq (h : α ≃ₜ β) (y : β) : comap h (𝓝 y) = 𝓝 (h.symm y) :=
by rw [h.nhds_eq_comap, h.apply_symm_apply]

/-- If an bijective map `e : α ≃ β` is continuous and open, then it is a homeomorphism. -/
def homeomorph_of_continuous_open (e : α ≃ β) (h₁ : continuous e) (h₂ : is_open_map e) :
  α ≃ₜ β :=
{ continuous_to_fun := h₁,
  continuous_inv_fun := begin
    rw continuous_def,
    intros s hs,
    convert ← h₂ s hs using 1,
    apply e.image_eq_preimage
  end,
  to_equiv := e }

@[simp] lemma comp_continuous_on_iff (h : α ≃ₜ β) (f : γ → α) (s : set γ) :
  continuous_on (h ∘ f) s ↔ continuous_on f s :=
h.inducing.continuous_on_iff.symm

@[simp] lemma comp_continuous_iff (h : α ≃ₜ β) {f : γ → α} :
  continuous (h ∘ f) ↔ continuous f :=
h.inducing.continuous_iff.symm

@[simp] lemma comp_continuous_iff' (h : α ≃ₜ β) {f : β → γ} :
  continuous (f ∘ h) ↔ continuous f :=
h.quotient_map.continuous_iff.symm

lemma comp_continuous_at_iff (h : α ≃ₜ β) (f : γ → α) (x : γ) :
  continuous_at (h ∘ f) x ↔ continuous_at f x :=
h.inducing.continuous_at_iff.symm

lemma comp_continuous_at_iff' (h : α ≃ₜ β) (f : β → γ) (x : α) :
  continuous_at (f ∘ h) x ↔ continuous_at f (h x) :=
h.inducing.continuous_at_iff' (by simp)

lemma comp_continuous_within_at_iff (h : α ≃ₜ β) (f : γ → α) (s : set γ) (x : γ) :
  continuous_within_at f s x ↔ continuous_within_at (h ∘ f) s x :=
h.inducing.continuous_within_at_iff

@[simp] lemma comp_is_open_map_iff (h : α ≃ₜ β) {f : γ → α} :
  is_open_map (h ∘ f) ↔ is_open_map f :=
begin
  refine ⟨_, λ hf, h.is_open_map.comp hf⟩,
  intros hf,
  rw [← function.comp.left_id f, ← h.symm_comp_self, function.comp.assoc],
  exact h.symm.is_open_map.comp hf,
end

@[simp] lemma comp_is_open_map_iff' (h : α ≃ₜ β) {f : β → γ} :
  is_open_map (f ∘ h) ↔ is_open_map f :=
begin
  refine ⟨_, λ hf, hf.comp h.is_open_map⟩,
  intros hf,
  rw [← function.comp.right_id f, ← h.self_comp_symm, ← function.comp.assoc],
  exact hf.comp h.symm.is_open_map,
end

/-- If two sets are equal, then they are homeomorphic. -/
def set_congr {s t : set α} (h : s = t) : s ≃ₜ t :=
{ continuous_to_fun := continuous_subtype_mk _ continuous_subtype_val,
  continuous_inv_fun := continuous_subtype_mk _ continuous_subtype_val,
  to_equiv := equiv.set_congr h }

/-- Sum of two homeomorphisms. -/
def sum_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α ⊕ γ ≃ₜ β ⊕ δ :=
{ continuous_to_fun  :=
  begin
    convert continuous_sum_rec (continuous_inl.comp h₁.continuous)
      (continuous_inr.comp h₂.continuous),
    ext x, cases x; refl,
  end,
  continuous_inv_fun :=
  begin
    convert continuous_sum_rec (continuous_inl.comp h₁.symm.continuous)
      (continuous_inr.comp h₂.symm.continuous),
    ext x, cases x; refl
  end,
  to_equiv := h₁.to_equiv.sum_congr h₂.to_equiv }

/-- Product of two homeomorphisms. -/
def prod_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α × γ ≃ₜ β × δ :=
{ continuous_to_fun  := (h₁.continuous.comp continuous_fst).prod_mk
    (h₂.continuous.comp continuous_snd),
  continuous_inv_fun := (h₁.symm.continuous.comp continuous_fst).prod_mk
    (h₂.symm.continuous.comp continuous_snd),
  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }

@[simp] lemma prod_congr_symm (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) :
  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl

@[simp] lemma coe_prod_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) :
  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl

section
variables (α β γ)

/-- `α × β` is homeomorphic to `β × α`. -/
def prod_comm : α × β ≃ₜ β × α :=
{ continuous_to_fun  := continuous_snd.prod_mk continuous_fst,
  continuous_inv_fun := continuous_snd.prod_mk continuous_fst,
  to_equiv := equiv.prod_comm α β }

@[simp] lemma prod_comm_symm : (prod_comm α β).symm = prod_comm β α := rfl
@[simp] lemma coe_prod_comm : ⇑(prod_comm α β) = prod.swap := rfl

/-- `(α × β) × γ` is homeomorphic to `α × (β × γ)`. -/
def prod_assoc : (α × β) × γ ≃ₜ α × (β × γ) :=
{ continuous_to_fun  := (continuous_fst.comp continuous_fst).prod_mk
    ((continuous_snd.comp continuous_fst).prod_mk continuous_snd),
  continuous_inv_fun := (continuous_fst.prod_mk (continuous_fst.comp continuous_snd)).prod_mk
    (continuous_snd.comp continuous_snd),
  to_equiv := equiv.prod_assoc α β γ }

/-- `α × {*}` is homeomorphic to `α`. -/
@[simps apply {fully_applied := ff}]
def prod_punit : α × punit ≃ₜ α :=
{ to_equiv := equiv.prod_punit α,
  continuous_to_fun := continuous_fst,
  continuous_inv_fun := continuous_id.prod_mk continuous_const }

/-- `{*} × α` is homeomorphic to `α`. -/
def punit_prod : punit × α ≃ₜ α :=
(prod_comm _ _).trans (prod_punit _)

@[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl

end

/-- `ulift α` is homeomorphic to `α`. -/
def {u v} ulift {α : Type u} [topological_space α] : ulift.{v u} α ≃ₜ α :=
{ continuous_to_fun := continuous_ulift_down,
  continuous_inv_fun := continuous_ulift_up,
  to_equiv := equiv.ulift }

section distrib

/-- `(α ⊕ β) × γ` is homeomorphic to `α × γ ⊕ β × γ`. -/
def sum_prod_distrib : (α ⊕ β) × γ ≃ₜ α × γ ⊕ β × γ :=
begin
  refine (homeomorph.homeomorph_of_continuous_open (equiv.sum_prod_distrib α β γ).symm _ _).symm,
  { convert continuous_sum_rec
      ((continuous_inl.comp continuous_fst).prod_mk continuous_snd)
      ((continuous_inr.comp continuous_fst).prod_mk continuous_snd),
    ext1 x, cases x; refl, },
  { exact (is_open_map_sum
    (open_embedding_inl.prod open_embedding_id).is_open_map
    (open_embedding_inr.prod open_embedding_id).is_open_map) }
end

/-- `α × (β ⊕ γ)` is homeomorphic to `α × β ⊕ α × γ`. -/
def prod_sum_distrib : α × (β ⊕ γ) ≃ₜ α × β ⊕ α × γ :=
(prod_comm _ _).trans $
sum_prod_distrib.trans $
sum_congr (prod_comm _ _) (prod_comm _ _)

variables {ι : Type*} {σ : ι → Type*} [Π i, topological_space (σ i)]

/-- `(Σ i, σ i) × β` is homeomorphic to `Σ i, (σ i × β)`. -/
def sigma_prod_distrib : ((Σ i, σ i) × β) ≃ₜ (Σ i, (σ i × β)) :=
homeomorph.symm $
homeomorph_of_continuous_open (equiv.sigma_prod_distrib σ β).symm
  (continuous_sigma $ λ i,
    (continuous_sigma_mk.comp continuous_fst).prod_mk continuous_snd)
  (is_open_map_sigma $ λ i,
    (open_embedding_sigma_mk.prod open_embedding_id).is_open_map)

end distrib

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps { fully_applied := ff }]
def fun_unique (ι α : Type*) [unique ι] [topological_space α] : (ι → α) ≃ₜ α :=
{ to_equiv := equiv.fun_unique ι α,
  continuous_to_fun := continuous_apply _,
  continuous_inv_fun := continuous_pi (λ _, continuous_id) }

/-- Homeomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
@[simps { fully_applied := ff }]
def {u} pi_fin_two (α : fin 2 → Type u) [Π i, topological_space (α i)] : (Π i, α i) ≃ₜ α 0 × α 1 :=
{ to_equiv := pi_fin_two_equiv α,
  continuous_to_fun := (continuous_apply 0).prod_mk (continuous_apply 1),
  continuous_inv_fun := continuous_pi $ fin.forall_fin_two.2 ⟨continuous_fst, continuous_snd⟩ }

/-- Homeomorphism between `α² = fin 2 → α` and `α × α`. -/
@[simps { fully_applied := ff }] def fin_two_arrow : (fin 2 → α) ≃ₜ α × α :=
{ to_equiv := fin_two_arrow_equiv α, ..  pi_fin_two (λ _, α) }

/--
A subset of a topological space is homeomorphic to its image under a homeomorphism.
-/
def image (e : α ≃ₜ β) (s : set α) : s ≃ₜ e '' s :=
{ continuous_to_fun := by continuity!,
  continuous_inv_fun := by continuity!,
  ..e.to_equiv.image s, }

end homeomorph


import ring_theory.is_tensor_product
import category_theory.limits.shapes.comm_sq
import ring_theory.polynomial.basic
import algebra.category.Ring.constructions

section
variables (R S : Type*) [comm_ring R] [comm_ring S] [algebra R S]

open_locale polynomial

@[reducible] noncomputable
def polynomial.polynomial_algebra_of_algebra :
  algebra R[X] S[X] := (polynomial.map_ring_hom $ algebra_map R S).to_algebra

local attribute [instance] polynomial.polynomial_algebra_of_algebra

@[simp]
lemma polynomial.polynomial_algebra_of_algebra_algebra_map_apply (p : R[X]) :
  algebra_map R[X] S[X] p = p.map (algebra_map R S) := rfl

instance polynomial.is_scalar_tower_of_algebra : is_scalar_tower R R[X] S[X] :=
is_scalar_tower.of_algebra_map_eq (λ x, (@polynomial.map_C _ _ x _ _ $ algebra_map R S).symm)

lemma algebra.is_pushout_iff_bijective {R S R' S' : Type*} [comm_ring R] [comm_ring S]
  [comm_ring R'] [comm_ring S']
  [algebra R S] [algebra R R'] [algebra S S'] [algebra R' S'] [algebra R S']
  [is_scalar_tower R R' S'] [is_scalar_tower R S S'] :
  algebra.is_pushout R R' S S' ↔ function.bijective (algebra.tensor_product.product_map
    (is_scalar_tower.to_alg_hom R R' S')
      (is_scalar_tower.to_alg_hom R S S')) :=
begin
  rw algebra.is_pushout_iff,
  change _ ↔ function.bijective (algebra.tensor_product.product_map _ _).to_linear_map,
  delta is_base_change is_tensor_product,
  congr',
  apply tensor_product.ext',
  intros x y,
  simp only [algebra.of_id_apply,
 tensor_product.lift.tmul,
 alg_hom.to_linear_map_apply,
 linear_map.smul_apply,
 module.algebra_map_End_apply,
 is_scalar_tower.coe_to_alg_hom',
 algebra.smul_def,
 algebra.tensor_product.product_map_apply_tmul,
 linear_map.coe_restrict_scalars_eq_coe,
 linear_map.flip_apply],
end

lemma algebra.tensor_product.ring_hom_ext {R A B S : Type*} [comm_ring R] [comm_ring A]
  [comm_ring B] [comm_ring S] [algebra R A] [algebra R B] (f g : tensor_product R A B →+* S)
    (h : f.comp algebra.tensor_product.include_left.to_ring_hom =
      g.comp algebra.tensor_product.include_left.to_ring_hom)
    (h' : f.comp algebra.tensor_product.include_right.to_ring_hom =
      g.comp algebra.tensor_product.include_right.to_ring_hom) : f = g :=
begin
  ext x,
  induction x using tensor_product.induction_on with x y x y hx hy,
  { rw [map_zero, map_zero] },
  { rw [← mul_one x, ← one_mul y, ← algebra.tensor_product.tmul_mul_tmul,
      map_mul, map_mul],
    congr' 1,
    exacts [(ring_hom.congr_fun h x : _), (ring_hom.congr_fun h' y : _)] },
  { rw [map_add, map_add, hx, hy] }
end

noncomputable
def tensor_product_polynomial_equiv  :
  tensor_product R S R[X] ≃ₐ[S] S[X] :=
{ inv_fun := (polynomial.eval₂_ring_hom (algebra.tensor_product.include_left.to_ring_hom :
    S →+* tensor_product R S R[X]) (1 ⊗ₜ polynomial.X) : _) ,
  left_inv := begin
    intro x,
    rw [alg_hom.to_fun_eq_coe, ← alg_hom.coe_to_ring_hom, ← ring_hom.comp_apply],
    conv_rhs { rw ← ring_hom.id_apply x },
    congr' 1,
    convert algebra.tensor_product.ring_hom_ext _ (ring_hom.id (tensor_product R S R[X])) _ _,
    { ext x, simp only [algebra.of_id_apply,
 polynomial.eval₂_C,
 mul_one,
 ring_hom_comp_triple.comp_eq,
 algebra.tensor_product.product_left_alg_hom_apply,
  polynomial.polynomial_algebra_of_algebra_algebra_map_apply,
 algebra.id.map_eq_id,
 ring_hom.to_fun_eq_coe,
 ring_hom.id_apply,
 alg_hom.coe_to_ring_hom,
 eq_self_iff_true,
 function.comp_app,
 polynomial.map_one,
 polynomial.coe_eval₂_ring_hom,
 ring_hom.coe_comp,
 is_scalar_tower.coe_to_alg_hom',
 algebra.tensor_product.include_left_apply,
 algebra.tensor_product.product_map_apply_tmul,
 alg_hom.coe_restrict_scalars',
 alg_hom.to_ring_hom_eq_coe,
 polynomial.algebra_map_apply]},
    ext y,
    { suffices : algebra_map R S y ⊗ₜ[R] 1 = 1 ⊗ₜ[R] polynomial.C y, { simpa only [polynomial.map_C,
 polynomial.eval₂_C,
 ring_hom_comp_triple.comp_eq,
 one_mul,
 algebra.tensor_product.product_left_alg_hom_apply,
 polynomial.polynomial_algebra_of_algebra_algebra_map_apply,
 ring_hom.to_fun_eq_coe,
 alg_hom.coe_to_ring_hom,
 function.comp_app,
 map_one,
 algebra.tensor_product.include_right_apply,
 polynomial.coe_eval₂_ring_hom,
 ring_hom.coe_comp,
 is_scalar_tower.coe_to_alg_hom',
 algebra.tensor_product.include_left_apply,
 algebra.tensor_product.product_map_apply_tmul,
 alg_hom.coe_restrict_scalars',
 alg_hom.to_ring_hom_eq_coe] using this },
      rw [algebra.algebra_map_eq_smul_one, tensor_product.smul_tmul,
        ← algebra.algebra_map_eq_smul_one, polynomial.algebra_map_apply], refl },
    { simp only [ring_hom_comp_triple.comp_eq,
 polynomial.map_X,
 one_mul,
 algebra.tensor_product.product_left_alg_hom_apply,
 polynomial.polynomial_algebra_of_algebra_algebra_map_apply,
 polynomial.eval₂_X,
 ring_hom.to_fun_eq_coe,
 alg_hom.coe_to_ring_hom,
 eq_self_iff_true,
 function.comp_app,
 map_one,
 algebra.tensor_product.include_right_apply,
 polynomial.coe_eval₂_ring_hom,
 ring_hom.coe_comp,
 is_scalar_tower.coe_to_alg_hom',
 algebra.tensor_product.product_map_apply_tmul,
 alg_hom.coe_restrict_scalars',
 alg_hom.to_ring_hom_eq_coe] }
  end,
  right_inv := begin
    intro x,
    rw [alg_hom.to_fun_eq_coe, ← alg_hom.coe_to_ring_hom, ← ring_hom.comp_apply],
    conv_rhs { rw ← ring_hom.id_apply x },
    congr' 1,
    ext y; simp only [ alg_hom.coe_restrict_scalars',
 alg_hom.coe_to_ring_hom,
 alg_hom.to_ring_hom_eq_coe,
 algebra.id.map_eq_id,
 algebra.of_id_apply,
 algebra.tensor_product.include_left_apply,
 algebra.tensor_product.product_left_alg_hom_apply,
 algebra.tensor_product.product_map_apply_tmul,
 polynomial.polynomial_algebra_of_algebra_algebra_map_apply,
 function.comp_app,
 is_scalar_tower.coe_to_alg_hom',
 map_one,
 mul_one,
 one_mul,
 polynomial.algebra_map_apply, polynomial.map_X,
 polynomial.coe_eval₂_ring_hom,
 polynomial.eval₂_C,
 polynomial.eval₂_X,
 polynomial.map_one,
 ring_hom.coe_comp,
 ring_hom.id_apply,
 ring_hom.to_fun_eq_coe,
 ring_hom_comp_triple.comp_eq]
  end,
  ..(algebra.tensor_product.product_left_alg_hom (algebra.of_id S S[X])
      (is_scalar_tower.to_alg_hom R R[X] S[X]) : _) }
.
@[instance]
lemma is_pushout_CommRing_polynomial (R S : Type*) [comm_ring R] [comm_ring S] [algebra R S] :
  algebra.is_pushout R S R[X] S[X] :=
begin
  rw algebra.is_pushout_iff_bijective,
  exact (tensor_product_polynomial_equiv R S).bijective,
end

open category_theory category_theory.limits

lemma algebra.is_pushout.to_is_pushout (R S R' S' : Type*) [comm_ring R] [comm_ring S]
  [comm_ring R'] [comm_ring S']
  [algebra R S] [algebra R R'] [algebra S S'] [algebra R' S'] [algebra R S']
  [is_scalar_tower R R' S'] [is_scalar_tower R S S'] [H : algebra.is_pushout R S R' S'] :
  is_pushout (CommRing.of_hom $ algebra_map R S) (CommRing.of_hom $ algebra_map R R')
   (CommRing.of_hom $ algebra_map S S') (CommRing.of_hom $ algebra_map R' S') :=
begin
  refine ⟨⟨_⟩, ⟨pushout_cocone.is_colimit_aux' _ _⟩⟩,
  { ext x, refine (is_scalar_tower.algebra_map_apply R S S' x)
      .symm.trans (is_scalar_tower.algebra_map_apply R R' S' x : _) },
  { intro s,
    let T := s.X,
    letI : algebra R T := (s.ι.app $ walking_span.zero).to_algebra,
    let f : S →ₐ[R] T :=
      { commutes' := ring_hom.congr_fun (s.ι.naturality walking_span.hom.fst), ..s.inl },
    let g : R' →ₐ[R] T :=
      { commutes' := ring_hom.congr_fun (s.ι.naturality walking_span.hom.snd), ..s.inr },
    refine ⟨(algebra.pushout_desc S' f g $ λ _ _, mul_comm _ _).to_ring_hom, _, _, _⟩,
    { ext, exact algebra.pushout_desc_left S' f g (λ _ _, mul_comm _ _) x },
    { ext, exact algebra.pushout_desc_right S' f g (λ _ _, mul_comm _ _) x },
    { intros m hm₁ hm₂,
      ext x,
      apply H.1.induction_on x,
  { simp only [map_zero] },
  { intro y, exact (ring_hom.congr_fun hm₂ y).trans
      (algebra.pushout_desc_right S' f g (λ _ _, mul_comm _ _) y).symm },
  { intros y y' e, rw [algebra.smul_def, map_mul, map_mul, e],
    congr' 1, exact (ring_hom.congr_fun hm₁ y).trans
      (algebra.pushout_desc_left  S' f g (λ _ _, mul_comm _ _) y).symm },
  { intros s₁ s₂ e₁ e₂, rw [map_add, map_add, e₁, e₂] } } }
end

end


/-
Copyright (c) 2020 Bhavik Mehta, E. W. Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, E. W. Ayers
-/

import category_theory.sites.sieves
import category_theory.limits.shapes.pullbacks
import order.copy

/-!
# Grothendieck topologies

Definition and lemmas about Grothendieck topologies.
A Grothendieck topology for a category `C` is a set of sieves on each object `X` satisfying
certain closure conditions.

Alternate versions of the axioms (in arrow form) are also described.
Two explicit examples of Grothendieck topologies are given:
* The dense topology
* The atomic topology
as well as the complete lattice structure on Grothendieck topologies (which gives two additional
explicit topologies: the discrete and trivial topologies.)

A pretopology, or a basis for a topology is defined in `pretopology.lean`. The topology associated
to a topological space is defined in `spaces.lean`.

## Tags

Grothendieck topology, coverage, pretopology, site

## References

* [https://ncatlab.org/nlab/show/Grothendieck+topology][nlab]
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM91]

## Implementation notes

We use the definition of [nlab] and [MM91](Chapter III, Section 2), where Grothendieck topologies
are saturated collections of morphisms, rather than the notions of the Stacks project (00VG) and
the Elephant, in which topologies are allowed to be unsaturated, and are then completed.
TODO (BM): Add the definition from Stacks, as a pretopology, and complete to a topology.

This is so that we can produce a bijective correspondence between Grothendieck topologies on a
small category and Lawvere-Tierney topologies on its presheaf topos, as well as the equivalence
between Grothendieck topoi and left exact reflective subcategories of presheaf toposes.
-/

universes v u
namespace category_theory

open category_theory category

variables (C : Type u) [category.{v} C]

/--
The definition of a Grothendieck topology: a set of sieves `J X` on each object `X` satisfying
three axioms:
1. For every object `X`, the maximal sieve is in `J X`.
2. If `S ∈ J X` then its pullback along any `h : Y ⟶ X` is in `J Y`.
3. If `S ∈ J X` and `R` is a sieve on `X`, then provided that the pullback of `R` along any arrow
   `f : Y ⟶ X` in `S` is in `J Y`, we have that `R` itself is in `J X`.

A sieve `S` on `X` is referred to as `J`-covering, (or just covering), if `S ∈ J X`.

See https://stacks.math.columbia.edu/tag/00Z4, or [nlab], or [MM92] Chapter III, Section 2,
Definition 1.
-/
structure grothendieck_topology :=
(sieves : Π (X : C), set (sieve X))
(top_mem' : ∀ X, ⊤ ∈ sieves X)
(pullback_stable' : ∀ ⦃X Y : C⦄ ⦃S : sieve X⦄ (f : Y ⟶ X), S ∈ sieves X → S.pullback f ∈ sieves Y)
(transitive' : ∀ ⦃X⦄ ⦃S : sieve X⦄ (hS : S ∈ sieves X) (R : sieve X),
              (∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → R.pullback f ∈ sieves Y) → R ∈ sieves X)

namespace grothendieck_topology

instance : has_coe_to_fun (grothendieck_topology C) :=
⟨_, λ J, J.sieves⟩

variables {C} {X Y : C} {S R : sieve X}
variables (J : grothendieck_topology C)

/--
An extensionality lemma in terms of the coercion to a pi-type.
We prove this explicitly rather than deriving it so that it is in terms of the coercion rather than
the projection `.sieves`.
-/
@[ext]
lemma ext {J₁ J₂ : grothendieck_topology C} (h : (J₁ : Π (X : C), set (sieve X)) = J₂) : J₁ = J₂ :=
by { cases J₁, cases J₂, congr, apply h }

@[simp] lemma mem_sieves_iff_coe : S ∈ J.sieves X ↔ S ∈ J X := iff.rfl

-- Also known as the maximality axiom.
@[simp] lemma top_mem (X : C) : ⊤ ∈ J X := J.top_mem' X
-- Also known as the stability axiom.
@[simp] lemma pullback_stable (f : Y ⟶ X) (hS : S ∈ J X) : S.pullback f ∈ J Y :=
J.pullback_stable' f hS
lemma transitive (hS : S ∈ J X) (R : sieve X)
  (h : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → R.pullback f ∈ J Y) :
  R ∈ J X :=
J.transitive' hS R h

lemma covering_of_eq_top : S = ⊤ → S ∈ J X := λ h, h.symm ▸ J.top_mem X

/--
If `S` is a subset of `R`, and `S` is covering, then `R` is covering as well.

See https://stacks.math.columbia.edu/tag/00Z5 (2), or discussion after [MM92] Chapter III,
Section 2, Definition 1.
-/
lemma superset_covering (Hss : S ≤ R) (sjx : S ∈ J X) : R ∈ J X :=
begin
  apply J.transitive sjx R (λ Y f hf, _),
  apply covering_of_eq_top,
  rw [← top_le_iff, ← S.pullback_eq_top_of_mem hf],
  apply sieve.pullback_monotone _ Hss,
end

/--
The intersection of two covering sieves is covering.

See https://stacks.math.columbia.edu/tag/00Z5 (1), or [MM92] Chapter III,
Section 2, Definition 1 (iv).
-/
lemma intersection_covering (rj : R ∈ J X) (sj : S ∈ J X) : R ⊓ S ∈ J X :=
begin
  apply J.transitive rj _ (λ Y f Hf, _),
  rw [sieve.pullback_inter, R.pullback_eq_top_of_mem Hf],
  simp [sj],
end

@[simp]
lemma intersection_covering_iff : R ⊓ S ∈ J X ↔ R ∈ J X ∧ S ∈ J X :=
⟨λ h, ⟨J.superset_covering inf_le_left h, J.superset_covering inf_le_right h⟩,
 λ t, intersection_covering _ t.1 t.2⟩

/--
The sieve `S` on `X` `J`-covers an arrow `f` to `X` if `S.pullback f ∈ J Y`.
This definition is an alternate way of presenting a Grothendieck topology.
-/
def covers (S : sieve X) (f : Y ⟶ X) : Prop := S.pullback f ∈ J Y

lemma covers_iff (S : sieve X) (f : Y ⟶ X) : J.covers S f ↔ S.pullback f ∈ J Y :=
iff.rfl

lemma covering_iff_covers_id (S : sieve X) : S ∈ J X ↔ J.covers S (𝟙 X) :=
by simp [covers_iff]

/-- The maximality axiom in 'arrow' form: Any arrow `f` in `S` is covered by `S`. -/
lemma arrow_max (f : Y ⟶ X) (S : sieve X) (hf : S f) : J.covers S f :=
begin
  rw [covers, (sieve.pullback_eq_top_iff_mem f).1 hf],
  apply J.top_mem,
end

/-- The stability axiom in 'arrow' form: If `S` covers `f` then `S` covers `g ≫ f` for any `g`. -/
lemma arrow_stable (f : Y ⟶ X) (S : sieve X) (h : J.covers S f) {Z : C} (g : Z ⟶ Y) :
  J.covers S (g ≫ f) :=
begin
  rw covers_iff at h ⊢,
  simp [h, sieve.pullback_comp],
end

/--
The transitivity axiom in 'arrow' form: If `S` covers `f` and every arrow in `S` is covered by
`R`, then `R` covers `f`.
-/
lemma arrow_trans (f : Y ⟶ X) (S R : sieve X) (h : J.covers S f) :
  (∀ {Z : C} (g : Z ⟶ X), S g → J.covers R g) → J.covers R f :=
begin
  intro k,
  apply J.transitive h,
  intros Z g hg,
  rw ← sieve.pullback_comp,
  apply k (g ≫ f) hg,
end

lemma arrow_intersect (f : Y ⟶ X) (S R : sieve X) (hS : J.covers S f) (hR : J.covers R f) :
  J.covers (S ⊓ R) f :=
by simpa [covers_iff] using and.intro hS hR

variable (C)
/--
The trivial Grothendieck topology, in which only the maximal sieve is covering. This topology is
also known as the indiscrete, coarse, or chaotic topology.

See [MM92] Chapter III, Section 2, example (a), or
https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies
-/
def trivial : grothendieck_topology C :=
{ sieves := λ X, {⊤},
  top_mem' := λ X, rfl,
  pullback_stable' := λ X Y S f hf,
  begin
    rw set.mem_singleton_iff at ⊢ hf,
    simp [hf],
  end,
  transitive' := λ X S hS R hR,
  begin
    rw [set.mem_singleton_iff, ← sieve.id_mem_iff_eq_top] at hS,
    simpa using hR hS,
  end }

/--
The discrete Grothendieck topology, in which every sieve is covering.

See https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies.
-/
def discrete : grothendieck_topology C :=
{ sieves := λ X, set.univ,
  top_mem' := by simp,
  pullback_stable' := λ X Y f, by simp,
  transitive' := by simp }
variable {C}

lemma trivial_covering : S ∈ trivial C X ↔ S = ⊤ := set.mem_singleton_iff

/-- See https://stacks.math.columbia.edu/tag/00Z6 -/
instance : partial_order (grothendieck_topology C) :=
{ le := λ J₁ J₂, (J₁ : Π (X : C), set (sieve X)) ≤ (J₂ : Π (X : C), set (sieve X)),
  le_refl := λ J₁, le_refl _,
  le_trans := λ J₁ J₂ J₃ h₁₂ h₂₃, le_trans h₁₂ h₂₃,
  le_antisymm := λ J₁ J₂ h₁₂ h₂₁, grothendieck_topology.ext (le_antisymm h₁₂ h₂₁) }

/-- See https://stacks.math.columbia.edu/tag/00Z7 -/
instance : has_Inf (grothendieck_topology C) :=
{ Inf := λ T,
  { sieves := Inf (sieves '' T),
    top_mem' :=
    begin
      rintro X S ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      simp,
    end,
    pullback_stable' :=
    begin
      rintro X Y S hS f _ ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      apply J.pullback_stable _ (f _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩),
    end,
    transitive' :=
    begin
      rintro X S hS R h _ ⟨⟨_, J, hJ, rfl⟩, rfl⟩,
      apply J.transitive (hS _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩) _ (λ Y f hf, h hf _ ⟨⟨_, _, hJ, rfl⟩, rfl⟩),
    end } }

/-- See https://stacks.math.columbia.edu/tag/00Z7 -/
lemma is_glb_Inf (s : set (grothendieck_topology C)) : is_glb s (Inf s) :=
begin
  refine @is_glb.of_image _ _ _ _ sieves _ _ _ _,
  { intros, refl },
  { exact is_glb_Inf _ },
end

/--
Construct a complete lattice from the `Inf`, but make the trivial and discrete topologies
definitionally equal to the bottom and top respectively.
-/
instance : complete_lattice (grothendieck_topology C) :=
complete_lattice.copy
(complete_lattice_of_Inf _ is_glb_Inf)
_ rfl
(discrete C)
(begin
  apply le_antisymm,
  { exact @complete_lattice.le_top _ (complete_lattice_of_Inf _ is_glb_Inf) (discrete C) },
  { intros X S hS,
    apply set.mem_univ },
end)
(trivial C)
(begin
  apply le_antisymm,
  { intros X S hS,
    rw trivial_covering at hS,
    apply covering_of_eq_top _ hS },
  { refine @complete_lattice.bot_le _ (complete_lattice_of_Inf _ is_glb_Inf) (trivial C) },
end)
_ rfl
_ rfl
_ rfl
Inf rfl

instance : inhabited (grothendieck_topology C) := ⟨⊤⟩

@[simp] lemma trivial_eq_bot : trivial C = ⊥ := rfl
@[simp] lemma discrete_eq_top : discrete C = ⊤ := rfl

@[simp] lemma bot_covering : S ∈ (⊥ : grothendieck_topology C) X ↔ S = ⊤ := trivial_covering
@[simp] lemma top_covering : S ∈ (⊤ : grothendieck_topology C) X := ⟨⟩

lemma bot_covers (S : sieve X) (f : Y ⟶ X) :
  (⊥ : grothendieck_topology C).covers S f ↔ S f :=
by rw [covers_iff, bot_covering, ← sieve.pullback_eq_top_iff_mem]

@[simp] lemma top_covers (S : sieve X) (f : Y ⟶ X) : (⊤ : grothendieck_topology C).covers S f :=
by simp [covers_iff]

/--
The dense Grothendieck topology.

See https://ncatlab.org/nlab/show/dense+topology, or [MM92] Chapter III, Section 2, example (e).
-/
def dense : grothendieck_topology C :=
{ sieves := λ X S, ∀ {Y : C} (f : Y ⟶ X), ∃ Z (g : Z ⟶ Y), S (g ≫ f),
  top_mem' := λ X Y f, ⟨Y, 𝟙 Y, ⟨⟩⟩,
  pullback_stable' :=
  begin
    intros X Y S h H Z f,
    rcases H (f ≫ h) with ⟨W, g, H'⟩,
    exact ⟨W, g, by simpa⟩,
  end,
  transitive' :=
  begin
    intros X S H₁ R H₂ Y f,
    rcases H₁ f with ⟨Z, g, H₃⟩,
    rcases H₂ H₃ (𝟙 Z) with ⟨W, h, H₄⟩,
    exact ⟨W, (h ≫ g), by simpa using H₄⟩,
  end }

lemma dense_covering : S ∈ dense X ↔ ∀ {Y} (f : Y ⟶ X), ∃ Z (g : Z ⟶ Y), S (g ≫ f) :=
iff.rfl

/--
A category satisfies the right Ore condition if any span can be completed to a commutative square.
NB. Any category with pullbacks obviously satisfies the right Ore condition, see
`right_ore_of_pullbacks`.
-/
def right_ore_condition (C : Type u) [category.{v} C] : Prop :=
∀ {X Y Z : C} (yx : Y ⟶ X) (zx : Z ⟶ X), ∃ W (wy : W ⟶ Y) (wz : W ⟶ Z), wy ≫ yx = wz ≫ zx

lemma right_ore_of_pullbacks [limits.has_pullbacks C] : right_ore_condition C :=
λ X Y Z yx zx, ⟨_, _, _, limits.pullback.condition⟩

/--
The atomic Grothendieck topology: a sieve is covering iff it is nonempty.
For the pullback stability condition, we need the right Ore condition to hold.

See https://ncatlab.org/nlab/show/atomic+site, or [MM92] Chapter III, Section 2, example (f).
-/
def atomic (hro : right_ore_condition C) : grothendieck_topology C :=
{ sieves := λ X S, ∃ Y (f : Y ⟶ X), S f,
  top_mem' := λ X, ⟨_, 𝟙 _, ⟨⟩⟩,
  pullback_stable' :=
  begin
    rintros X Y S h ⟨Z, f, hf⟩,
    rcases hro h f with ⟨W, g, k, comm⟩,
    refine ⟨_, g, _⟩,
    simp [comm, hf],
  end,
  transitive' :=
  begin
    rintros X S ⟨Y, f, hf⟩ R h,
    rcases h hf with ⟨Z, g, hg⟩,
    exact ⟨_, _, hg⟩,
  end }

end grothendieck_topology

end category_theory


/-
Copyright (c) 2022 Arthur Paulino. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino
-/
import Mathlib.Tactic.Replace

set_option linter.unusedVariables false

-- tests with a explicitly named hypothesis

example (h : Int) : Nat := by
  replace h : Nat := 0
  exact h

example (h : Nat) : Nat := by
  have h : Int := 0
  assumption -- original `h` is not absent but...

example (h : Nat) : Nat := by
  replace h : Int := 0
  fail_if_success assumption -- original `h` is absent now
  replace h : Nat := 0
  exact h

-- tests with `this`

example : Nat := by
  have : Int := 0
  replace : Nat := 0
  assumption

example : Nat := by
  have : Nat := 0
  have : Int := 0
  assumption -- original `this` is not absent but...

example : Nat := by
  have : Nat := 0
  replace : Int := 0
  fail_if_success assumption -- original `this` is absent now
  replace : Nat := 0
  assumption

-- trying to replace the type of a variable when the goal depends on it

example {a : Nat} : a = a := by
  replace a : Int := 0
  have : Nat := by assumption -- old `a` is not gone
  have : Int := by exact a    -- new `a` is of type `Int`
  simp

-- tests without `:=`, creating a new subgoal

example (z : Int) : Nat := by
  replace z : Nat
  exact 0
  assumption

example : True := by
  have : 1 + 1 = 2 := by simp_arith
  replace : 2 + 2 = 4
  simp_arith
  trivial


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module control.traversable.equiv
! leanprover-community/mathlib commit 706d88f2b8fdfeb0b22796433d7a6c1a010af9f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Control.Traversable.Lemmas
import Mathlib.Logic.Equiv.Defs

/-!
# Transferring `Traversable` instances along isomorphisms

This file allows to transfer `Traversable` instances along isomorphisms.

## Main declarations

* `Equiv.map`: Turns functorially a function `α → β` into a function `t' α → t' β` using the functor
  `t` and the equivalence `Π α, t α ≃ t' α`.
* `Equiv.functor`: `Equiv.map` as a functor.
* `Equiv.traverse`: Turns traversably a function `α → m β` into a function `t' α → m (t' β)` using
  the traversable functor `t` and the equivalence `Π α, t α ≃ t' α`.
* `Equiv.traversable`: `Equiv.traverse` as a traversable functor.
* `Equiv.isLawfulTraversable`: `Equiv.traverse` as a lawful traversable functor.
-/

universe u

namespace Equiv

section Functor

-- Porting note: `parameter` doesn't seem to work yet.
variable {t t' : Type u → Type u} (eqv : ∀ α, t α ≃ t' α)

variable [Functor t]

open Functor

/-- Given a functor `t`, a function `t' : Type u → Type u`, and
equivalences `t α ≃ t' α` for all `α`, then every function `α → β` can
be mapped to a function `t' α → t' β` functorially (see
`Equiv.functor`). -/
protected def map {α β : Type u} (f : α → β) (x : t' α) : t' β :=
  eqv β <| map f ((eqv α).symm x)
#align equiv.map Equiv.map

/-- The function `Equiv.map` transfers the functoriality of `t` to
`t'` using the equivalences `eqv`.  -/
protected def functor : Functor t' where map := Equiv.map eqv
#align equiv.functor Equiv.functor

-- Porting note: `LawfulFunctor` is missing an `#align`.
variable [LawfulFunctor t]

protected theorem id_map {α : Type u} (x : t' α) : Equiv.map eqv id x = x := by
  simp [Equiv.map, id_map]
#align equiv.id_map Equiv.id_map

protected theorem comp_map {α β γ : Type u} (g : α → β) (h : β → γ) (x : t' α) :
    Equiv.map eqv (h ∘ g) x = Equiv.map eqv h (Equiv.map eqv g x) := by
  simp [Equiv.map]; apply comp_map
#align equiv.comp_map Equiv.comp_map

protected theorem lawfulFunctor : @LawfulFunctor _ (Equiv.functor eqv) :=
  -- Porting note: why is `_inst` required here?
  let _inst := Equiv.functor eqv; {
    map_const := fun {_ _} => rfl
    id_map := Equiv.id_map eqv
    comp_map := Equiv.comp_map eqv }
#align equiv.is_lawful_functor Equiv.lawfulFunctor

protected theorem lawfulFunctor' [F : Functor t']
    (h₀ : ∀ {α β} (f : α → β), Functor.map f = Equiv.map eqv f)
    (h₁ : ∀ {α β} (f : β), Functor.mapConst f = (Equiv.map eqv ∘ Function.const α) f) :
    LawfulFunctor t' := by
  have : F = Equiv.functor eqv := by
    cases F
    dsimp [Equiv.functor]
    congr <;> ext <;> dsimp only <;> [rw [← h₀], rw [← h₁]] <;> rfl
  subst this
  exact Equiv.lawfulFunctor eqv
#align equiv.is_lawful_functor' Equiv.lawfulFunctor'

end Functor

section Traversable

variable {t t' : Type u → Type u} (eqv : ∀ α, t α ≃ t' α)

variable [Traversable t]

variable {m : Type u → Type u} [Applicative m]

variable {α β : Type u}

/-- Like `Equiv.map`, a function `t' : Type u → Type u` can be given
the structure of a traversable functor using a traversable functor
`t'` and equivalences `t α ≃ t' α` for all α. See `Equiv.traversable`. -/
protected def traverse (f : α → m β) (x : t' α) : m (t' β) :=
  eqv β <$> traverse f ((eqv α).symm x)
#align equiv.traverse Equiv.traverse

/-- The function `Equiv.traverse` transfers a traversable functor
instance across the equivalences `eqv`. -/
protected def traversable : Traversable t' where
  toFunctor := Equiv.functor eqv
  traverse := Equiv.traverse eqv
#align equiv.traversable Equiv.traversable

end Traversable

section Equiv

variable {t t' : Type u → Type u} (eqv : ∀ α, t α ≃ t' α)

-- Porting note: The naming `IsLawfulTraversable` seems weird, why not `LawfulTraversable`?
-- Is this to do with the fact it lives in `Type (u+1)` not `Prop`?
variable [Traversable t] [IsLawfulTraversable t]

variable {F G : Type u → Type u} [Applicative F] [Applicative G]

variable [LawfulApplicative F] [LawfulApplicative G]

variable (η : ApplicativeTransformation F G)

variable {α β γ : Type u}

open IsLawfulTraversable Functor

-- Porting note: Id.bind_eq is missing an `#align`.

protected theorem id_traverse (x : t' α) : Equiv.traverse eqv (pure : α → Id α) x = x := by
  -- Porting note: Changing this `simp` to an `rw` somehow breaks the proof of `comp_traverse`.
  simp [Equiv.traverse]
#align equiv.id_traverse Equiv.id_traverse

protected theorem traverse_eq_map_id (f : α → β) (x : t' α) :
    Equiv.traverse eqv ((pure : β → Id β) ∘ f) x = pure (Equiv.map eqv f x) := by
  simp [Equiv.traverse, traverse_eq_map_id, functor_norm]; rfl
#align equiv.traverse_eq_map_id Equiv.traverse_eq_map_id

protected theorem comp_traverse (f : β → F γ) (g : α → G β) (x : t' α) :
    Equiv.traverse eqv (Comp.mk ∘ Functor.map f ∘ g) x =
      Comp.mk (Equiv.traverse eqv f <$> Equiv.traverse eqv g x) := by
  simp [Equiv.traverse, comp_traverse, functor_norm]; congr; ext; simp
#align equiv.comp_traverse Equiv.comp_traverse

protected theorem naturality (f : α → F β) (x : t' α) :
    η (Equiv.traverse eqv f x) = Equiv.traverse eqv (@η _ ∘ f) x := by
  simp only [Equiv.traverse, functor_norm]
#align equiv.naturality Equiv.naturality

/-- The fact that `t` is a lawful traversable functor carries over the
equivalences to `t'`, with the traversable functor structure given by
`Equiv.traversable`. -/
protected def isLawfulTraversable : @IsLawfulTraversable t' (Equiv.traversable eqv) :=
  -- Porting note: Same `_inst` local variable problem.
  let _inst := Equiv.traversable eqv; {
    toLawfulFunctor := Equiv.lawfulFunctor eqv
    id_traverse := Equiv.id_traverse eqv
    comp_traverse := Equiv.comp_traverse eqv
    traverse_eq_map_id := Equiv.traverse_eq_map_id eqv
    naturality := Equiv.naturality eqv }
#align equiv.is_lawful_traversable Equiv.isLawfulTraversable

/-- If the `Traversable t'` instance has the properties that `map`,
`map_const`, and `traverse` are equal to the ones that come from
carrying the traversable functor structure from `t` over the
equivalences, then the fact that `t` is a lawful traversable functor
carries over as well. -/
protected def isLawfulTraversable' [Traversable t']
    (h₀ : ∀ {α β} (f : α → β), map f = Equiv.map eqv f)
    (h₁ : ∀ {α β} (f : β), mapConst f = (Equiv.map eqv ∘ Function.const α) f)
    (h₂ :
      ∀ {F : Type u → Type u} [Applicative F],
        ∀ [LawfulApplicative F] {α β} (f : α → F β), traverse f = Equiv.traverse eqv f) :
    IsLawfulTraversable t' := by
  -- we can't use the same approach as for `lawful_functor'` because
  -- h₂ needs a `LawfulApplicative` assumption
  refine' { toLawfulFunctor := Equiv.lawfulFunctor' eqv @h₀ @h₁.. } <;> intros
  · rw [h₂, Equiv.id_traverse]
  · rw [h₂, Equiv.comp_traverse, h₂]
    congr
    rw [h₂]
  · rw [h₂, Equiv.traverse_eq_map_id, h₀]; rfl
  · rw [h₂, Equiv.naturality, h₂]
#align equiv.is_lawful_traversable' Equiv.isLawfulTraversable'

end Equiv

end Equiv


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.sort
import Mathlib.data.matrix.notation
import Mathlib.linear_algebra.affine_space.combination
import Mathlib.linear_algebra.basis
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l

namespace Mathlib

/-!
# Affine independence

This file defines affinely independent families of points.

## Main definitions

* `affine_independent` defines affinely independent families of points
  as those where no nontrivial weighted subtraction is 0.  This is
  proved equivalent to two other formulations: linear independence of
  the results of subtracting a base point in the family from the other
  points in the family, or any equal affine combinations having the
  same weights.  A bundled type `simplex` is provided for finite
  affinely independent families of points, with an abbreviation
  `triangle` for the case of three points.

## References

* https://en.wikipedia.org/wiki/Affine_space

-/

/-- An indexed family is said to be affinely independent if no
nontrivial weighted subtractions (where the sum of weights is 0) are
0. -/
def affine_independent (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] {ι : Type u_4} (p : ι → P) :=
  ∀ (s : finset ι) (w : ι → k),
    (finset.sum s fun (i : ι) => w i) = 0 →
      coe_fn (finset.weighted_vsub s p) w = 0 → ∀ (i : ι), i ∈ s → w i = 0

/-- The definition of `affine_independent`. -/
theorem affine_independent_def (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (p : ι → P) :
    affine_independent k p ↔
        ∀ (s : finset ι) (w : ι → k),
          (finset.sum s fun (i : ι) => w i) = 0 →
            coe_fn (finset.weighted_vsub s p) w = 0 → ∀ (i : ι), i ∈ s → w i = 0 :=
  iff.rfl

/-- A family with at most one point is affinely independent. -/
theorem affine_independent_of_subsingleton (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [subsingleton ι] (p : ι → P) :
    affine_independent k p :=
  fun (s : finset ι) (w : ι → k) (h : (finset.sum s fun (i : ι) => w i) = 0)
    (hs : coe_fn (finset.weighted_vsub s p) w = 0) (i : ι) (hi : i ∈ s) =>
    fintype.eq_of_subsingleton_of_sum_eq h i hi

/-- A family indexed by a `fintype` is affinely independent if and
only if no nontrivial weighted subtractions over `finset.univ` (where
the sum of the weights is 0) are 0. -/
theorem affine_independent_iff_of_fintype (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [fintype ι] (p : ι → P) :
    affine_independent k p ↔
        ∀ (w : ι → k),
          (finset.sum finset.univ fun (i : ι) => w i) = 0 →
            coe_fn (finset.weighted_vsub finset.univ p) w = 0 → ∀ (i : ι), w i = 0 :=
  sorry

/-- A family is affinely independent if and only if the differences
from a base point in that family are linearly independent. -/
theorem affine_independent_iff_linear_independent_vsub (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (p : ι → P) (i1 : ι) :
    affine_independent k p ↔
        linear_independent k fun (i : Subtype fun (x : ι) => x ≠ i1) => p ↑i -ᵥ p i1 :=
  sorry

/-- A set is affinely independent if and only if the differences from
a base point in that set are linearly independent. -/
theorem affine_independent_set_iff_linear_independent_vsub (k : Type u_1) {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {s : set P} {p₁ : P}
    (hp₁ : p₁ ∈ s) :
    (affine_independent k fun (p : ↥s) => ↑p) ↔
        linear_independent k fun (v : ↥((fun (p : P) => p -ᵥ p₁) '' (s \ singleton p₁))) => ↑v :=
  sorry

/-- A set of nonzero vectors is linearly independent if and only if,
given a point `p₁`, the vectors added to `p₁` and `p₁` itself are
affinely independent. -/
theorem linear_independent_set_iff_affine_independent_vadd_union_singleton (k : Type u_1)
    {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P]
    {s : set V} (hs : ∀ (v : V), v ∈ s → v ≠ 0) (p₁ : P) :
    (linear_independent k fun (v : ↥s) => ↑v) ↔
        affine_independent k fun (p : ↥(singleton p₁ ∪ (fun (v : V) => v +ᵥ p₁) '' s)) => ↑p :=
  sorry

/-- A family is affinely independent if and only if any affine
combinations (with sum of weights 1) that evaluate to the same point
have equal `set.indicator`. -/
theorem affine_independent_iff_indicator_eq_of_affine_combination_eq (k : Type u_1) {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    (p : ι → P) :
    affine_independent k p ↔
        ∀ (s1 s2 : finset ι) (w1 w2 : ι → k),
          (finset.sum s1 fun (i : ι) => w1 i) = 1 →
            (finset.sum s2 fun (i : ι) => w2 i) = 1 →
              coe_fn (finset.affine_combination s1 p) w1 =
                  coe_fn (finset.affine_combination s2 p) w2 →
                set.indicator (↑s1) w1 = set.indicator (↑s2) w2 :=
  sorry

/-- An affinely independent family is injective, if the underlying
ring is nontrivial. -/
theorem injective_of_affine_independent {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) : function.injective p :=
  sorry

/-- If a family is affinely independent, so is any subfamily given by
composition of an embedding into index type with the original
family. -/
theorem affine_independent_embedding_of_affine_independent {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    {ι2 : Type u_5} (f : ι2 ↪ ι) {p : ι → P} (ha : affine_independent k p) :
    affine_independent k (p ∘ ⇑f) :=
  sorry

/-- If a family is affinely independent, so is any subfamily indexed
by a subtype of the index type. -/
theorem affine_independent_subtype_of_affine_independent {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    {p : ι → P} (ha : affine_independent k p) (s : set ι) :
    affine_independent k fun (i : ↥s) => p ↑i :=
  affine_independent_embedding_of_affine_independent
    (function.embedding.subtype fun (x : ι) => x ∈ s) ha

/-- If an indexed family of points is affinely independent, so is the
corresponding set of points. -/
theorem affine_independent_set_of_affine_independent {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {p : ι → P}
    (ha : affine_independent k p) : affine_independent k fun (x : ↥(set.range p)) => ↑x :=
  sorry

/-- If a set of points is affinely independent, so is any subset. -/
theorem affine_independent_of_subset_affine_independent {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {s : set P} {t : set P}
    (ha : affine_independent k fun (x : ↥t) => ↑x) (hs : s ⊆ t) :
    affine_independent k fun (x : ↥s) => ↑x :=
  affine_independent_embedding_of_affine_independent (set.embedding_of_subset s t hs) ha

/-- If the range of an injective indexed family of points is affinely
independent, so is that family. -/
theorem affine_independent_of_affine_independent_set_of_injective {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    {p : ι → P} (ha : affine_independent k fun (x : ↥(set.range p)) => ↑x)
    (hi : function.injective p) : affine_independent k p :=
  sorry

/-- If a family is affinely independent, and the spans of points
indexed by two subsets of the index type have a point in common, those
subsets of the index type have an element in common, if the underlying
ring is nontrivial. -/
theorem exists_mem_inter_of_exists_mem_inter_affine_span_of_affine_independent {k : Type u_1}
    {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P]
    {ι : Type u_4} [nontrivial k] {p : ι → P} (ha : affine_independent k p) {s1 : set ι}
    {s2 : set ι} {p0 : P} (hp0s1 : p0 ∈ affine_span k (p '' s1))
    (hp0s2 : p0 ∈ affine_span k (p '' s2)) : ∃ (i : ι), i ∈ s1 ∩ s2 :=
  sorry

/-- If a family is affinely independent, the spans of points indexed
by disjoint subsets of the index type are disjoint, if the underlying
ring is nontrivial. -/
theorem affine_span_disjoint_of_disjoint_of_affine_independent {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    [nontrivial k] {p : ι → P} (ha : affine_independent k p) {s1 : set ι} {s2 : set ι}
    (hd : s1 ∩ s2 = ∅) : ↑(affine_span k (p '' s1)) ∩ ↑(affine_span k (p '' s2)) = ∅ :=
  sorry

/-- If a family is affinely independent, a point in the family is in
the span of some of the points given by a subset of the index type if
and only if that point's index is in the subset, if the underlying
ring is nontrivial. -/
@[simp] theorem mem_affine_span_iff_mem_of_affine_independent {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4}
    [nontrivial k] {p : ι → P} (ha : affine_independent k p) (i : ι) (s : set ι) :
    p i ∈ affine_span k (p '' s) ↔ i ∈ s :=
  sorry

/-- If a family is affinely independent, a point in the family is not
in the affine span of the other points, if the underlying ring is
nontrivial. -/
theorem not_mem_affine_span_diff_of_affine_independent {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [nontrivial k]
    {p : ι → P} (ha : affine_independent k p) (i : ι) (s : set ι) :
    ¬p i ∈ affine_span k (p '' (s \ singleton i)) :=
  sorry

/-- An affinely independent set of points can be extended to such a
set that spans the whole space. -/
theorem exists_subset_affine_independent_affine_span_eq_top {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [field k] [add_comm_group V] [module k V] [add_torsor V P] {s : set P}
    (h : affine_independent k fun (p : ↥s) => ↑p) :
    ∃ (t : set P), s ⊆ t ∧ (affine_independent k fun (p : ↥t) => ↑p) ∧ affine_span k t = ⊤ :=
  sorry

/-- Two different points are affinely independent. -/
theorem affine_independent_of_ne (k : Type u_1) {V : Type u_2} {P : Type u_3} [field k]
    [add_comm_group V] [module k V] [add_torsor V P] {p₁ : P} {p₂ : P} (h : p₁ ≠ p₂) :
    affine_independent k (matrix.vec_cons p₁ (matrix.vec_cons p₂ matrix.vec_empty)) :=
  sorry

namespace affine

/-- A `simplex k P n` is a collection of `n + 1` affinely
independent points. -/
structure simplex (k : Type u_1) {V : Type u_2} (P : Type u_3) [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] (n : ℕ)
    where
  points : fin (n + 1) → P
  independent : affine_independent k points

/-- A `triangle k P` is a collection of three affinely independent points. -/
def triangle (k : Type u_1) {V : Type u_2} (P : Type u_3) [ring k] [add_comm_group V] [module k V]
    [add_torsor V P] :=
  simplex k P (bit0 1)

namespace simplex

/-- Construct a 0-simplex from a point. -/
def mk_of_point (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] (p : P) : simplex k P 0 :=
  mk (fun (_x : fin (0 + 1)) => p) sorry

/-- The point in a simplex constructed with `mk_of_point`. -/
@[simp] theorem mk_of_point_points (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] (p : P) (i : fin 1) :
    points (mk_of_point k p) i = p :=
  rfl

protected instance inhabited (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] [Inhabited P] : Inhabited (simplex k P 0) :=
  { default := mk_of_point k Inhabited.default }

protected instance nonempty (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] : Nonempty (simplex k P 0) :=
  Nonempty.intro (mk_of_point k (nonempty.some add_torsor.nonempty))

/-- Two simplices are equal if they have the same points. -/
theorem ext {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V]
    [add_torsor V P] {n : ℕ} {s1 : simplex k P n} {s2 : simplex k P n}
    (h : ∀ (i : fin (n + 1)), points s1 i = points s2 i) : s1 = s2 :=
  sorry

/-- Two simplices are equal if and only if they have the same points. -/
theorem ext_iff {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] {n : ℕ} (s1 : simplex k P n) (s2 : simplex k P n) :
    s1 = s2 ↔ ∀ (i : fin (n + 1)), points s1 i = points s2 i :=
  { mp := fun (h : s1 = s2) (_x : fin (n + 1)) => h ▸ rfl, mpr := ext }

/-- A face of a simplex is a simplex with the given subset of
points. -/
def face {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V]
    [add_torsor V P] {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
    (h : finset.card fs = m + 1) : simplex k P m :=
  mk (points s ∘ ⇑(finset.order_emb_of_fin fs h)) sorry

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
theorem face_points {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
    (h : finset.card fs = m + 1) (i : fin (m + 1)) :
    points (face s h) i = points s (coe_fn (finset.order_emb_of_fin fs h) i) :=
  rfl

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
theorem face_points' {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [add_torsor V P] {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
    (h : finset.card fs = m + 1) : points (face s h) = points s ∘ ⇑(finset.order_emb_of_fin fs h) :=
  rfl

/-- A single-point face equals the 0-simplex constructed with
`mk_of_point`. -/
@[simp] theorem face_eq_mk_of_point {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {n : ℕ} (s : simplex k P n) (i : fin (n + 1)) :
    face s (finset.card_singleton i) = mk_of_point k (points s i) :=
  sorry

/-- The set of points of a face. -/
@[simp] theorem range_face_points {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {n : ℕ} (s : simplex k P n)
    {fs : finset (fin (n + 1))} {m : ℕ} (h : finset.card fs = m + 1) :
    set.range (points (face s h)) = points s '' ↑fs :=
  sorry

end simplex

end affine

namespace affine

namespace simplex

/-- The centroid of a face of a simplex as the centroid of a subset of
the points. -/
@[simp] theorem face_centroid_eq_centroid {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {n : ℕ} (s : simplex k P n)
    {fs : finset (fin (n + 1))} {m : ℕ} (h : finset.card fs = m + 1) :
    finset.centroid k finset.univ (points (face s h)) = finset.centroid k fs (points s) :=
  sorry

/-- Over a characteristic-zero division ring, the centroids given by
two subsets of the points of a simplex are equal if and only if those
faces are given by the same subset of points. -/
@[simp] theorem centroid_eq_iff {k : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] [char_zero k] {n : ℕ} (s : simplex k P n)
    {fs₁ : finset (fin (n + 1))} {fs₂ : finset (fin (n + 1))} {m₁ : ℕ} {m₂ : ℕ}
    (h₁ : finset.card fs₁ = m₁ + 1) (h₂ : finset.card fs₂ = m₂ + 1) :
    finset.centroid k fs₁ (points s) = finset.centroid k fs₂ (points s) ↔ fs₁ = fs₂ :=
  sorry

/-- Over a characteristic-zero division ring, the centroids of two
faces of a simplex are equal if and only if those faces are given by
the same subset of points. -/
theorem face_centroid_eq_iff {k : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] [char_zero k] {n : ℕ} (s : simplex k P n)
    {fs₁ : finset (fin (n + 1))} {fs₂ : finset (fin (n + 1))} {m₁ : ℕ} {m₂ : ℕ}
    (h₁ : finset.card fs₁ = m₁ + 1) (h₂ : finset.card fs₂ = m₂ + 1) :
    finset.centroid k finset.univ (points (face s h₁)) =
          finset.centroid k finset.univ (points (face s h₂)) ↔
        fs₁ = fs₂ :=
  sorry

/-- Two simplices with the same points have the same centroid. -/
theorem centroid_eq_of_range_eq {k : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {n : ℕ} {s₁ : simplex k P n}
    {s₂ : simplex k P n} (h : set.range (points s₁) = set.range (points s₂)) :
    finset.centroid k finset.univ (points s₁) = finset.centroid k finset.univ (points s₂) :=
  sorry

end Mathlib