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

/-!
# Bases of topologies. Countability axioms.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A topological basis on a topological space `t` is a collection of sets,
such that all open sets can be generated as unions of these sets, without the need to take
finite intersections of them. This file introduces a framework for dealing with these collections,
and also what more we can say under certain countability conditions on bases,
which are referred to as first- and second-countable.
We also briefly cover the theory of separable spaces, which are those with a countable, dense
subset. If a space is second-countable, and also has a countably generated uniformity filter
(for example, if `t` is a metric space), it will automatically be separable (and indeed, these
conditions are equivalent in this case).

## Main definitions

* `is_topological_basis s`: The topological space `t` has basis `s`.
* `separable_space α`: The topological space `t` has a countable, dense subset.
* `is_separable s`: The set `s` is contained in the closure of a countable set.
* `first_countable_topology α`: A topology in which `𝓝 x` is countably generated for every `x`.
* `second_countable_topology α`: A topology which has a topological basis which is countable.

## Main results

* `first_countable_topology.tendsto_subseq`: In a first-countable space,
  cluster points are limits of subsequences.
* `second_countable_topology.is_open_Union_countable`: In a second-countable space, the union of
  arbitrarily-many open sets is equal to a sub-union of only countably many of these sets.
* `second_countable_topology.countable_cover_nhds`: Consider `f : α → set α` with the property that
  `f x ∈ 𝓝 x` for all `x`. Then there is some countable set `s` whose image covers the space.

## Implementation Notes
For our applications we are interested that there exists a countable basis, but we do not need the
concrete basis itself. This allows us to declare these type classes as `Prop` to use them as mixins.

### TODO:
More fine grained instances for `first_countable_topology`, `separable_space`, `t2_space`, and more
(see the comment below `subtype.second_countable_topology`.)
-/

open set filter function
open_locale topology filter
noncomputable theory

namespace topological_space

universe u
variables {α : Type u} [t : topological_space α]
include t

/-- A topological basis is one that satisfies the necessary conditions so that
  it suffices to take unions of the basis sets to get a topology (without taking
  finite intersections as well). -/
structure is_topological_basis (s : set (set α)) : Prop :=
(exists_subset_inter : ∀t₁∈s, ∀t₂∈s, ∀ x ∈ t₁ ∩ t₂, ∃ t₃∈s, x ∈ t₃ ∧ t₃ ⊆ t₁ ∩ t₂)
(sUnion_eq : (⋃₀ s) = univ)
(eq_generate_from : t = generate_from s)

lemma is_topological_basis.insert_empty {s : set (set α)} (h : is_topological_basis s) :
  is_topological_basis (insert ∅ s) :=
begin
  refine ⟨_, by rw [sUnion_insert, empty_union, h.sUnion_eq], _⟩,
  { rintro t₁ (rfl|h₁) t₂ (rfl|h₂) x ⟨hx₁, hx₂⟩, {cases hx₁}, {cases hx₁}, {cases hx₂},
    obtain ⟨t₃, h₃, hs⟩ := h.exists_subset_inter _ h₁ _ h₂ x ⟨hx₁, hx₂⟩,
    exact ⟨t₃, or.inr h₃, hs⟩ },
  { rw h.eq_generate_from,
    refine le_antisymm (le_generate_from $ λ t, _) (generate_from_anti $ subset_insert ∅ s),
    rintro (rfl|ht), { convert is_open_empty }, { exact generate_open.basic t ht } },
end

lemma is_topological_basis.diff_empty {s : set (set α)} (h : is_topological_basis s) :
  is_topological_basis (s \ {∅}) :=
begin
  refine ⟨_, by rw [sUnion_diff_singleton_empty, h.sUnion_eq], _⟩,
  { rintro t₁ ⟨h₁, -⟩ t₂ ⟨h₂, -⟩ x hx,
    obtain ⟨t₃, h₃, hs⟩ := h.exists_subset_inter _ h₁ _ h₂ x hx,
    exact ⟨t₃, ⟨h₃, nonempty.ne_empty ⟨x, hs.1⟩⟩, hs⟩ },
  { rw h.eq_generate_from,
    refine le_antisymm (generate_from_anti $ diff_subset s _) (le_generate_from $ λ t ht, _),
    obtain rfl|he := eq_or_ne t ∅, { convert is_open_empty },
    exact generate_open.basic t ⟨ht, he⟩ },
end

/-- If a family of sets `s` generates the topology, then intersections of finite
subcollections of `s` form a topological basis. -/
lemma is_topological_basis_of_subbasis {s : set (set α)} (hs : t = generate_from s) :
  is_topological_basis ((λ f, ⋂₀ f) '' {f : set (set α) | f.finite ∧ f ⊆ s}) :=
begin
  refine ⟨_, _, hs.trans (le_antisymm (le_generate_from _) $ generate_from_anti $ λ t ht, _)⟩,
  { rintro _ ⟨t₁, ⟨hft₁, ht₁b⟩, rfl⟩ _ ⟨t₂, ⟨hft₂, ht₂b⟩, rfl⟩ x h,
    exact ⟨_, ⟨_, ⟨hft₁.union hft₂, union_subset ht₁b ht₂b⟩, sInter_union t₁ t₂⟩, h, subset.rfl⟩ },
  { rw [sUnion_image, Union₂_eq_univ_iff],
    exact λ x, ⟨∅, ⟨finite_empty, empty_subset _⟩, sInter_empty.substr $ mem_univ x⟩ },
  { rintro _ ⟨t, ⟨hft, htb⟩, rfl⟩, apply is_open_sInter,
    exacts [hft, λ s hs, generate_open.basic _ $ htb hs] },
  { rw ← sInter_singleton t,
    exact ⟨{t}, ⟨finite_singleton t, singleton_subset_iff.2 ht⟩, rfl⟩ },
end

/-- If a family of open sets `s` is such that every open neighbourhood contains some
member of `s`, then `s` is a topological basis. -/
lemma is_topological_basis_of_open_of_nhds {s : set (set α)}
  (h_open : ∀ u ∈ s, is_open u)
  (h_nhds : ∀(a:α) (u : set α), a ∈ u → is_open u → ∃v ∈ s, a ∈ v ∧ v ⊆ u) :
  is_topological_basis s :=
begin
  refine ⟨λ t₁ ht₁ t₂ ht₂ x hx, h_nhds _ _ hx (is_open.inter (h_open _ ht₁) (h_open _ ht₂)), _, _⟩,
  { refine sUnion_eq_univ_iff.2 (λ a, _),
    rcases h_nhds a univ trivial is_open_univ with ⟨u, h₁, h₂, -⟩,
    exact ⟨u, h₁, h₂⟩ },
  { refine (le_generate_from h_open).antisymm (λ u hu, _),
    refine (@is_open_iff_nhds α (generate_from s) u).mpr (λ a ha, _),
    rcases h_nhds a u ha hu with ⟨v, hvs, hav, hvu⟩,
    rw nhds_generate_from,
    exact infi₂_le_of_le v ⟨hav, hvs⟩ (le_principal_iff.2 hvu) }
end

/-- A set `s` is in the neighbourhood of `a` iff there is some basis set `t`, which
contains `a` and is itself contained in `s`. -/
lemma is_topological_basis.mem_nhds_iff {a : α} {s : set α} {b : set (set α)}
  (hb : is_topological_basis b) : s ∈ 𝓝 a ↔ ∃ t ∈ b, a ∈ t ∧ t ⊆ s :=
begin
  change s ∈ (𝓝 a).sets ↔ ∃ t ∈ b, a ∈ t ∧ t ⊆ s,
  rw [hb.eq_generate_from, nhds_generate_from, binfi_sets_eq],
  { simp [and_assoc, and.left_comm] },
  { exact assume s ⟨hs₁, hs₂⟩ t ⟨ht₁, ht₂⟩,
      have a ∈ s ∩ t, from ⟨hs₁, ht₁⟩,
      let ⟨u, hu₁, hu₂, hu₃⟩ := hb.1 _ hs₂ _ ht₂ _ this in
      ⟨u, ⟨hu₂, hu₁⟩, le_principal_iff.2 (subset.trans hu₃ (inter_subset_left _ _)),
        le_principal_iff.2 (subset.trans hu₃ (inter_subset_right _ _))⟩ },
  { rcases eq_univ_iff_forall.1 hb.sUnion_eq a with ⟨i, h1, h2⟩,
    exact ⟨i, h2, h1⟩ }
end

lemma is_topological_basis.is_open_iff {s : set α} {b : set (set α)} (hb : is_topological_basis b) :
  is_open s ↔ ∀ a ∈ s, ∃ t ∈ b, a ∈ t ∧ t ⊆ s :=
by simp [is_open_iff_mem_nhds, hb.mem_nhds_iff]

lemma is_topological_basis.nhds_has_basis {b : set (set α)} (hb : is_topological_basis b) {a : α} :
  (𝓝 a).has_basis (λ t : set α, t ∈ b ∧ a ∈ t) (λ t, t) :=
⟨λ s, hb.mem_nhds_iff.trans $ by simp only [exists_prop, and_assoc]⟩

protected lemma is_topological_basis.is_open {s : set α} {b : set (set α)}
  (hb : is_topological_basis b) (hs : s ∈ b) : is_open s :=
by { rw hb.eq_generate_from, exact generate_open.basic s hs }

protected lemma is_topological_basis.mem_nhds {a : α} {s : set α} {b : set (set α)}
  (hb : is_topological_basis b) (hs : s ∈ b) (ha : a ∈ s) : s ∈ 𝓝 a :=
(hb.is_open hs).mem_nhds ha

lemma is_topological_basis.exists_subset_of_mem_open {b : set (set α)}
  (hb : is_topological_basis b) {a:α} {u : set α} (au : a ∈ u)
  (ou : is_open u) : ∃v ∈ b, a ∈ v ∧ v ⊆ u :=
hb.mem_nhds_iff.1 $ is_open.mem_nhds ou au

 /-- Any open set is the union of the basis sets contained in it. -/
lemma is_topological_basis.open_eq_sUnion' {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  u = ⋃₀ {s ∈ B | s ⊆ u} :=
ext $ λ a,
⟨λ ha, let ⟨b, hb, ab, bu⟩ := hB.exists_subset_of_mem_open ha ou in ⟨b, ⟨hb, bu⟩, ab⟩,
  λ ⟨b, ⟨hb, bu⟩, ab⟩, bu ab⟩

lemma is_topological_basis.open_eq_sUnion {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  ∃ S ⊆ B, u = ⋃₀ S :=
⟨{s ∈ B | s ⊆ u}, λ s h, h.1, hB.open_eq_sUnion' ou⟩

lemma is_topological_basis.open_iff_eq_sUnion {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} :
  is_open u ↔ ∃ S ⊆ B, u = ⋃₀ S :=
⟨hB.open_eq_sUnion, λ ⟨S, hSB, hu⟩, hu.symm ▸ is_open_sUnion (λ s hs, hB.is_open (hSB hs))⟩

lemma is_topological_basis.open_eq_Union {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  ∃ (β : Type u) (f : β → set α), u = (⋃ i, f i) ∧ ∀ i, f i ∈ B :=
⟨↥{s ∈ B | s ⊆ u}, coe, by { rw ← sUnion_eq_Union, apply hB.open_eq_sUnion' ou }, λ s, and.left s.2⟩

 /-- A point `a` is in the closure of `s` iff all basis sets containing `a` intersect `s`. -/
lemma is_topological_basis.mem_closure_iff {b : set (set α)} (hb : is_topological_basis b)
  {s : set α} {a : α} :
  a ∈ closure s ↔ ∀ o ∈ b, a ∈ o → (o ∩ s).nonempty :=
(mem_closure_iff_nhds_basis' hb.nhds_has_basis).trans $ by simp only [and_imp]

 /-- A set is dense iff it has non-trivial intersection with all basis sets. -/
lemma is_topological_basis.dense_iff {b : set (set α)} (hb : is_topological_basis b) {s : set α} :
  dense s ↔ ∀ o ∈ b, set.nonempty o → (o ∩ s).nonempty :=
begin
  simp only [dense, hb.mem_closure_iff],
  exact ⟨λ h o hb ⟨a, ha⟩, h a o hb ha, λ h a o hb ha, h o hb ⟨a, ha⟩⟩
end

lemma is_topological_basis.is_open_map_iff {β} [topological_space β] {B : set (set α)}
  (hB : is_topological_basis B) {f : α → β} :
  is_open_map f ↔ ∀ s ∈ B, is_open (f '' s) :=
begin
  refine ⟨λ H o ho, H _ (hB.is_open ho), λ hf o ho, _⟩,
  rw [hB.open_eq_sUnion' ho, sUnion_eq_Union, image_Union],
  exact is_open_Union (λ s, hf s s.2.1)
end

lemma is_topological_basis.exists_nonempty_subset {B : set (set α)}
  (hb : is_topological_basis B) {u : set α} (hu : u.nonempty) (ou : is_open u) :
  ∃ v ∈ B, set.nonempty v ∧ v ⊆ u :=
begin
  cases hu with x hx,
  rw [hb.open_eq_sUnion' ou, mem_sUnion] at hx,
  rcases hx with ⟨v, hv, hxv⟩,
  exact ⟨v, hv.1, ⟨x, hxv⟩, hv.2⟩
end

lemma is_topological_basis_opens : is_topological_basis { U : set α | is_open U } :=
is_topological_basis_of_open_of_nhds (by tauto) (by tauto)

protected lemma is_topological_basis.prod {β} [topological_space β] {B₁ : set (set α)}
  {B₂ : set (set β)} (h₁ : is_topological_basis B₁) (h₂ : is_topological_basis B₂) :
  is_topological_basis (image2 (×ˢ) B₁ B₂) :=
begin
  refine is_topological_basis_of_open_of_nhds _ _,
  { rintro _ ⟨u₁, u₂, hu₁, hu₂, rfl⟩,
    exact (h₁.is_open hu₁).prod (h₂.is_open hu₂) },
  { rintro ⟨a, b⟩ u hu uo,
    rcases (h₁.nhds_has_basis.prod_nhds h₂.nhds_has_basis).mem_iff.1 (is_open.mem_nhds uo hu)
      with ⟨⟨s, t⟩, ⟨⟨hs, ha⟩, ht, hb⟩, hu⟩,
    exact ⟨s ×ˢ t, mem_image2_of_mem hs ht, ⟨ha, hb⟩, hu⟩ }
end

protected lemma is_topological_basis.inducing {β} [topological_space β]
  {f : α → β} {T : set (set β)} (hf : inducing f) (h : is_topological_basis T) :
  is_topological_basis (image (preimage f) T) :=
begin
  refine is_topological_basis_of_open_of_nhds _ _,
  { rintros _ ⟨V, hV, rfl⟩,
    rwa hf.is_open_iff,
    refine ⟨V, h.is_open hV, rfl⟩ },
  { intros a U ha hU,
    rw hf.is_open_iff at hU,
    obtain ⟨V, hV, rfl⟩ := hU,
    obtain ⟨S, hS, rfl⟩ := h.open_eq_sUnion hV,
    obtain ⟨W, hW, ha⟩ := ha,
    refine ⟨f ⁻¹' W, ⟨_, hS hW, rfl⟩, ha, set.preimage_mono $ set.subset_sUnion_of_mem hW⟩ }
end

lemma is_topological_basis_of_cover {ι} {U  : ι → set α} (Uo : ∀ i, is_open (U i))
  (Uc : (⋃ i, U i) = univ) {b : Π i, set (set (U i))} (hb : ∀ i, is_topological_basis (b i)) :
  is_topological_basis (⋃ i : ι, image (coe : U i → α) '' (b i)) :=
begin
  refine is_topological_basis_of_open_of_nhds (λ u hu, _) _,
  { simp only [mem_Union, mem_image] at hu,
    rcases hu with ⟨i, s, sb, rfl⟩,
    exact (Uo i).is_open_map_subtype_coe _ ((hb i).is_open sb) },
  { intros a u ha uo,
    rcases Union_eq_univ_iff.1 Uc a with ⟨i, hi⟩,
    lift a to ↥(U i) using hi,
    rcases (hb i).exists_subset_of_mem_open (by exact ha) (uo.preimage continuous_subtype_coe)
      with ⟨v, hvb, hav, hvu⟩,
    exact ⟨coe '' v, mem_Union.2 ⟨i, mem_image_of_mem _ hvb⟩, mem_image_of_mem _ hav,
      image_subset_iff.2 hvu⟩ }
end

protected lemma is_topological_basis.continuous {β : Type*} [topological_space β]
  {B : set (set β)} (hB : is_topological_basis B) (f : α → β) (hf : ∀ s ∈ B, is_open (f ⁻¹' s)) :
  continuous f :=
begin rw hB.eq_generate_from, exact continuous_generated_from hf end

variables (α)

/-- A separable space is one with a countable dense subset, available through
`topological_space.exists_countable_dense`. If `α` is also known to be nonempty, then
`topological_space.dense_seq` provides a sequence `ℕ → α` with dense range, see
`topological_space.dense_range_dense_seq`.

If `α` is a uniform space with countably generated uniformity filter (e.g., an `emetric_space`),
then this condition is equivalent to `topological_space.second_countable_topology α`. In this case
the latter should be used as a typeclass argument in theorems because Lean can automatically deduce
`separable_space` from `second_countable_topology` but it can't deduce `second_countable_topology`
and `emetric_space`. -/
class separable_space : Prop :=
(exists_countable_dense : ∃s:set α, s.countable ∧ dense s)

lemma exists_countable_dense [separable_space α] :
  ∃ s : set α, s.countable ∧ dense s :=
separable_space.exists_countable_dense

/-- A nonempty separable space admits a sequence with dense range. Instead of running `cases` on the
conclusion of this lemma, you might want to use `topological_space.dense_seq` and
`topological_space.dense_range_dense_seq`.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
lemma exists_dense_seq [separable_space α] [nonempty α] : ∃ u : ℕ → α, dense_range u :=
begin
  obtain ⟨s : set α, hs, s_dense⟩ := exists_countable_dense α,
  cases set.countable_iff_exists_subset_range.mp hs with u hu,
  exact ⟨u, s_dense.mono hu⟩,
end

/-- A dense sequence in a non-empty separable topological space.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
def dense_seq [separable_space α] [nonempty α] : ℕ → α := classical.some (exists_dense_seq α)

/-- The sequence `dense_seq α` has dense range. -/
@[simp] lemma dense_range_dense_seq [separable_space α] [nonempty α] :
  dense_range (dense_seq α) := classical.some_spec (exists_dense_seq α)

variable {α}

@[priority 100]
instance countable.to_separable_space [countable α] : separable_space α :=
{ exists_countable_dense := ⟨set.univ, set.countable_univ, dense_univ⟩ }

lemma separable_space_of_dense_range {ι : Type*} [countable ι] (u : ι → α) (hu : dense_range u) :
  separable_space α :=
⟨⟨range u, countable_range u, hu⟩⟩

/-- In a separable space, a family of nonempty disjoint open sets is countable. -/
lemma _root_.set.pairwise_disjoint.countable_of_is_open [separable_space α] {ι : Type*}
  {s : ι → set α} {a : set ι} (h : a.pairwise_disjoint s) (ha : ∀ i ∈ a, is_open (s i))
  (h'a : ∀ i ∈ a, (s i).nonempty) :
  a.countable :=
begin
  rcases exists_countable_dense α with ⟨u, ⟨u_encodable⟩, u_dense⟩,
  have : ∀ i : a, ∃ y, y ∈ s i ∩ u :=
    λ i, dense_iff_inter_open.1 u_dense (s i) (ha i i.2) (h'a i i.2),
  choose f hfs hfu using this,
  lift f to a → u using hfu,
  have f_inj : injective f,
  { refine injective_iff_pairwise_ne.mpr
      ((h.subtype _ _).mono $ λ i j hij hfij, hij.le_bot ⟨hfs i, _⟩),
    simp only [congr_arg coe hfij, hfs j] },
  exact ⟨@encodable.of_inj _ _ u_encodable f f_inj⟩
end

/-- In a separable space, a family of disjoint sets with nonempty interiors is countable. -/
lemma _root_.set.pairwise_disjoint.countable_of_nonempty_interior [separable_space α] {ι : Type*}
  {s : ι → set α} {a : set ι} (h : a.pairwise_disjoint s)
  (ha : ∀ i ∈ a, (interior (s i)).nonempty) :
  a.countable :=
(h.mono $ λ i, interior_subset).countable_of_is_open (λ i hi, is_open_interior) ha

/-- A set `s` in a topological space is separable if it is contained in the closure of a
countable set `c`. Beware that this definition does not require that `c` is contained in `s` (to
express the latter, use `separable_space s` or `is_separable (univ : set s))`. In metric spaces,
the two definitions are equivalent, see `topological_space.is_separable.separable_space`. -/
def is_separable (s : set α) :=
∃ c : set α, c.countable ∧ s ⊆ closure c

lemma is_separable.mono {s u : set α} (hs : is_separable s) (hu : u ⊆ s) :
  is_separable u :=
begin
  rcases hs with ⟨c, c_count, hs⟩,
  exact ⟨c, c_count, hu.trans hs⟩
end

lemma is_separable.union {s u : set α} (hs : is_separable s) (hu : is_separable u) :
  is_separable (s ∪ u) :=
begin
  rcases hs with ⟨cs, cs_count, hcs⟩,
  rcases hu with ⟨cu, cu_count, hcu⟩,
  refine ⟨cs ∪ cu, cs_count.union cu_count, _⟩,
  exact union_subset (hcs.trans (closure_mono (subset_union_left _ _)))
    (hcu.trans (closure_mono (subset_union_right _ _)))
end

lemma is_separable.closure {s : set α} (hs : is_separable s) : is_separable (closure s) :=
begin
  rcases hs with ⟨c, c_count, hs⟩,
  exact ⟨c, c_count, by simpa using closure_mono hs⟩,
end

lemma is_separable_Union {ι : Type*} [countable ι] {s : ι → set α} (hs : ∀ i, is_separable (s i)) :
  is_separable (⋃ i, s i) :=
begin
  choose c hc h'c using hs,
  refine ⟨⋃ i, c i, countable_Union hc, Union_subset_iff.2 (λ i, _)⟩,
  exact (h'c i).trans (closure_mono (subset_Union _ i))
end

lemma _root_.set.countable.is_separable {s : set α} (hs : s.countable) : is_separable s :=
⟨s, hs, subset_closure⟩

lemma _root_.set.finite.is_separable {s : set α} (hs : s.finite) : is_separable s :=
hs.countable.is_separable

lemma is_separable_univ_iff :
  is_separable (univ : set α) ↔ separable_space α :=
begin
  split,
  { rintros ⟨c, c_count, hc⟩,
    refine ⟨⟨c, c_count, by rwa [dense_iff_closure_eq, ← univ_subset_iff]⟩⟩ },
  { introsI h,
    rcases exists_countable_dense α with ⟨c, c_count, hc⟩,
    exact ⟨c, c_count, by rwa [univ_subset_iff, ← dense_iff_closure_eq]⟩ }
end

lemma is_separable_of_separable_space [h : separable_space α] (s : set α) : is_separable s :=
is_separable.mono (is_separable_univ_iff.2 h) (subset_univ _)

lemma is_separable.image {β : Type*} [topological_space β]
  {s : set α} (hs : is_separable s) {f : α → β} (hf : continuous f) :
  is_separable (f '' s) :=
begin
  rcases hs with ⟨c, c_count, hc⟩,
  refine ⟨f '' c, c_count.image _, _⟩,
  rw image_subset_iff,
  exact hc.trans (closure_subset_preimage_closure_image hf)
end

lemma is_separable_of_separable_space_subtype (s : set α) [separable_space s] : is_separable s :=
begin
  have : is_separable ((coe : s → α) '' (univ : set s)) :=
    (is_separable_of_separable_space _).image continuous_subtype_coe,
  simpa only [image_univ, subtype.range_coe_subtype],
end

end topological_space

open topological_space

lemma is_topological_basis_pi {ι : Type*} {X : ι → Type*}
  [∀ i, topological_space (X i)] {T : Π i, set (set (X i))}
  (cond : ∀ i, is_topological_basis (T i)) :
  is_topological_basis {S : set (Π i, X i) | ∃ (U : Π i, set (X i)) (F : finset ι),
    (∀ i, i ∈ F → (U i) ∈ T i) ∧ S = (F : set ι).pi U } :=
begin
  refine is_topological_basis_of_open_of_nhds _ _,
  { rintro _ ⟨U, F, h1, rfl⟩,
    apply is_open_set_pi F.finite_to_set,
    intros i hi,
    exact (cond i).is_open (h1 i hi) },
  { intros a U ha hU,
    obtain ⟨I, t, hta, htU⟩ :
      ∃ (I : finset ι) (t : Π (i : ι), set (X i)), (∀ i, t i ∈ 𝓝 (a i)) ∧ set.pi ↑I t ⊆ U,
    { rw [← filter.mem_pi', ← nhds_pi], exact hU.mem_nhds ha },
    have : ∀ i, ∃ V ∈ T i, a i ∈ V ∧ V ⊆ t i := λ i, (cond i).mem_nhds_iff.1 (hta i),
    choose V hVT haV hVt,
    exact ⟨_, ⟨V, I, λ i hi, hVT i, rfl⟩, λ i hi, haV i, (pi_mono $ λ i hi, hVt i).trans htU⟩ },
end

lemma is_topological_basis_infi {β : Type*} {ι : Type*} {X : ι → Type*}
  [t : ∀ i, topological_space (X i)] {T : Π i, set (set (X i))}
  (cond : ∀ i, is_topological_basis (T i)) (f : Π i, β → X i) :
  @is_topological_basis β (⨅ i, induced (f i) (t i))
  { S | ∃ (U : Π i, set (X i)) (F : finset ι),
    (∀ i, i ∈ F → U i ∈ T i) ∧ S = ⋂ i (hi : i ∈ F), (f i) ⁻¹' (U i) } :=
begin
  convert (is_topological_basis_pi cond).inducing (inducing_infi_to_pi _),
  ext V,
  split,
  { rintros ⟨U, F, h1, h2⟩,
    have : (F : set ι).pi U = (⋂ (i : ι) (hi : i ∈ F),
        (λ (z : Π j, X j), z i) ⁻¹' (U i)), by { ext, simp },
    refine ⟨(F : set ι).pi U, ⟨U, F, h1, rfl⟩, _⟩,
    rw [this, h2, set.preimage_Inter],
    congr' 1,
    ext1,
    rw set.preimage_Inter,
    refl },
  { rintros ⟨U, ⟨U, F, h1, rfl⟩, h⟩,
    refine ⟨U, F, h1, _⟩,
    have : (F : set ι).pi U = (⋂ (i : ι) (hi : i ∈ F),
        (λ (z : Π j, X j), z i) ⁻¹' (U i)), by { ext, simp },
    rw [← h, this, set.preimage_Inter],
    congr' 1,
    ext1,
    rw set.preimage_Inter,
    refl }
end

lemma is_topological_basis_singletons (α : Type*) [topological_space α] [discrete_topology α] :
  is_topological_basis {s | ∃ (x : α), (s : set α) = {x}} :=
is_topological_basis_of_open_of_nhds (λ u hu, is_open_discrete _) $
  λ x u hx u_open, ⟨{x}, ⟨x, rfl⟩, mem_singleton x, singleton_subset_iff.2 hx⟩

/-- If `α` is a separable space and `f : α → β` is a continuous map with dense range, then `β` is
a separable space as well. E.g., the completion of a separable uniform space is separable. -/
protected lemma dense_range.separable_space {α β : Type*} [topological_space α] [separable_space α]
  [topological_space β] {f : α → β} (h : dense_range f) (h' : continuous f) :
  separable_space β :=
let ⟨s, s_cnt, s_dense⟩ := exists_countable_dense α in
⟨⟨f '' s, countable.image s_cnt f, h.dense_image h' s_dense⟩⟩

lemma dense.exists_countable_dense_subset {α : Type*} [topological_space α]
  {s : set α} [separable_space s] (hs : dense s) :
  ∃ t ⊆ s, t.countable ∧ dense t :=
let ⟨t, htc, htd⟩ := exists_countable_dense s
in ⟨coe '' t, image_subset_iff.2 $ λ x _, mem_preimage.2 $ subtype.coe_prop _, htc.image coe,
  hs.dense_range_coe.dense_image continuous_subtype_val htd⟩

/-- Let `s` be a dense set in a topological space `α` with partial order structure. If `s` is a
separable space (e.g., if `α` has a second countable topology), then there exists a countable
dense subset `t ⊆ s` such that `t` contains bottom/top element of `α` when they exist and belong
to `s`. For a dense subset containing neither bot nor top elements, see
`dense.exists_countable_dense_subset_no_bot_top`. -/
lemma dense.exists_countable_dense_subset_bot_top {α : Type*} [topological_space α]
  [partial_order α] {s : set α} [separable_space s] (hs : dense s) :
  ∃ t ⊆ s, t.countable ∧ dense t ∧ (∀ x, is_bot x → x ∈ s → x ∈ t) ∧
    (∀ x, is_top x → x ∈ s → x ∈ t) :=
begin
  rcases hs.exists_countable_dense_subset with ⟨t, hts, htc, htd⟩,
  refine ⟨(t ∪ ({x | is_bot x} ∪ {x | is_top x})) ∩ s, _, _, _, _, _⟩,
  exacts [inter_subset_right _ _,
    (htc.union ((countable_is_bot α).union (countable_is_top α))).mono (inter_subset_left _ _),
    htd.mono (subset_inter (subset_union_left _ _) hts),
    λ x hx hxs, ⟨or.inr $ or.inl hx, hxs⟩, λ x hx hxs, ⟨or.inr $ or.inr hx, hxs⟩]
end

instance separable_space_univ {α : Type*} [topological_space α] [separable_space α] :
  separable_space (univ : set α) :=
(equiv.set.univ α).symm.surjective.dense_range.separable_space (continuous_id.subtype_mk _)

/-- If `α` is a separable topological space with a partial order, then there exists a countable
dense set `s : set α` that contains those of both bottom and top elements of `α` that actually
exist. For a dense set containing neither bot nor top elements, see
`exists_countable_dense_no_bot_top`. -/
lemma exists_countable_dense_bot_top (α : Type*) [topological_space α] [separable_space α]
  [partial_order α] :
  ∃ s : set α, s.countable ∧ dense s ∧ (∀ x, is_bot x → x ∈ s) ∧ (∀ x, is_top x → x ∈ s) :=
by simpa using dense_univ.exists_countable_dense_subset_bot_top

namespace topological_space
universe u
variables (α : Type u) [t : topological_space α]
include t

/-- A first-countable space is one in which every point has a
  countable neighborhood basis. -/
class first_countable_topology : Prop :=
(nhds_generated_countable : ∀a:α, (𝓝 a).is_countably_generated)

attribute [instance] first_countable_topology.nhds_generated_countable

namespace first_countable_topology
variable {α}

/-- In a first-countable space, a cluster point `x` of a sequence
is the limit of some subsequence. -/
lemma tendsto_subseq [first_countable_topology α] {u : ℕ → α} {x : α}
  (hx : map_cluster_pt x at_top u) :
  ∃ (ψ : ℕ → ℕ), (strict_mono ψ) ∧ (tendsto (u ∘ ψ) at_top (𝓝 x)) :=
subseq_tendsto_of_ne_bot hx

end first_countable_topology

variables {α}

instance {β} [topological_space β] [first_countable_topology α] [first_countable_topology β] :
  first_countable_topology (α × β) :=
⟨λ ⟨x, y⟩, by { rw nhds_prod_eq, apply_instance }⟩

section pi

omit t

instance {ι : Type*} {π : ι → Type*} [countable ι] [Π i, topological_space (π i)]
  [∀ i, first_countable_topology (π i)] : first_countable_topology (Π i, π i) :=
⟨λ f, by { rw nhds_pi, apply_instance }⟩

end pi

instance is_countably_generated_nhds_within (x : α) [is_countably_generated (𝓝 x)] (s : set α) :
  is_countably_generated (𝓝[s] x) :=
inf.is_countably_generated _ _

variable (α)

/-- A second-countable space is one with a countable basis. -/
class second_countable_topology : Prop :=
(is_open_generated_countable [] :
  ∃ b : set (set α), b.countable ∧ t = topological_space.generate_from b)

variable {α}

protected lemma is_topological_basis.second_countable_topology
  {b : set (set α)} (hb : is_topological_basis b) (hc : b.countable) :
  second_countable_topology α :=
⟨⟨b, hc, hb.eq_generate_from⟩⟩

variable (α)

lemma exists_countable_basis [second_countable_topology α] :
  ∃ b : set (set α), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b :=
begin
  obtain ⟨b, hb₁, hb₂⟩ := second_countable_topology.is_open_generated_countable α,
  refine ⟨_, _, not_mem_diff_of_mem _, (is_topological_basis_of_subbasis hb₂).diff_empty⟩,
  exacts [((countable_set_of_finite_subset hb₁).image _).mono (diff_subset _ _), rfl],
end

/-- A countable topological basis of `α`. -/
def countable_basis [second_countable_topology α] : set (set α) :=
(exists_countable_basis α).some

lemma countable_countable_basis [second_countable_topology α] : (countable_basis α).countable :=
(exists_countable_basis α).some_spec.1

instance encodable_countable_basis [second_countable_topology α] :
  encodable (countable_basis α) :=
(countable_countable_basis α).to_encodable

lemma empty_nmem_countable_basis [second_countable_topology α] : ∅ ∉ countable_basis α :=
(exists_countable_basis α).some_spec.2.1

lemma is_basis_countable_basis [second_countable_topology α] :
  is_topological_basis (countable_basis α) :=
(exists_countable_basis α).some_spec.2.2

lemma eq_generate_from_countable_basis [second_countable_topology α] :
  ‹topological_space α› = generate_from (countable_basis α) :=
(is_basis_countable_basis α).eq_generate_from

variable {α}

lemma is_open_of_mem_countable_basis [second_countable_topology α] {s : set α}
  (hs : s ∈ countable_basis α) : is_open s :=
(is_basis_countable_basis α).is_open hs

lemma nonempty_of_mem_countable_basis [second_countable_topology α] {s : set α}
  (hs : s ∈ countable_basis α) : s.nonempty :=
nonempty_iff_ne_empty.2 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α

variable (α)

@[priority 100] -- see Note [lower instance priority]
instance second_countable_topology.to_first_countable_topology
  [second_countable_topology α] : first_countable_topology α :=
⟨λ x, has_countable_basis.is_countably_generated $
  ⟨(is_basis_countable_basis α).nhds_has_basis, (countable_countable_basis α).mono $
    inter_subset_left _ _⟩⟩

/-- If `β` is a second-countable space, then its induced topology
via `f` on `α` is also second-countable. -/
lemma second_countable_topology_induced (β)
  [t : topological_space β] [second_countable_topology β] (f : α → β) :
  @second_countable_topology α (t.induced f) :=
begin
  rcases second_countable_topology.is_open_generated_countable β with ⟨b, hb, eq⟩,
  refine { is_open_generated_countable := ⟨preimage f '' b, hb.image _, _⟩ },
  rw [eq, induced_generate_from_eq]
end

instance subtype.second_countable_topology (s : set α) [second_countable_topology α] :
  second_countable_topology s :=
second_countable_topology_induced s α coe

/- TODO: more fine grained instances for first_countable_topology, separable_space, t2_space, ... -/
instance {β : Type*} [topological_space β]
  [second_countable_topology α] [second_countable_topology β] : second_countable_topology (α × β) :=
((is_basis_countable_basis α).prod (is_basis_countable_basis β)).second_countable_topology $
  (countable_countable_basis α).image2 (countable_countable_basis β) _

instance {ι : Type*} {π : ι → Type*}
  [countable ι] [t : ∀a, topological_space (π a)] [∀a, second_countable_topology (π a)] :
  second_countable_topology (∀a, π a) :=
begin
  have : t = (λa, generate_from (countable_basis (π a))),
    from funext (assume a, (is_basis_countable_basis (π a)).eq_generate_from),
  rw [this, pi_generate_from_eq],
  constructor, refine ⟨_, _, rfl⟩,
  have : set.countable {T : set (Π i, π i) | ∃ (I : finset ι) (s : Π i : I, set (π i)),
    (∀ i, s i ∈ countable_basis (π i)) ∧ T = {f | ∀ i : I, f i ∈ s i}},
  { simp only [set_of_exists, ← exists_prop],
    refine countable_Union (λ I, countable.bUnion _ (λ _ _, countable_singleton _)),
    change set.countable {s : Π i : I, set (π i) | ∀ i, s i ∈ countable_basis (π i)},
    exact countable_pi (λ i, countable_countable_basis _) },
  convert this using 1, ext1 T, split,
  { rintro ⟨s, I, hs, rfl⟩,
    refine ⟨I, λ i, s i, λ i, hs i i.2, _⟩,
    simp only [set.pi, set_coe.forall'], refl },
  { rintro ⟨I, s, hs, rfl⟩,
    rcases @subtype.surjective_restrict ι (λ i, set (π i)) _ (λ i, i ∈ I) s with ⟨s, rfl⟩,
    exact ⟨s, I, λ i hi, hs ⟨i, hi⟩, set.ext $ λ f, subtype.forall⟩ }
end

@[priority 100] -- see Note [lower instance priority]
instance second_countable_topology.to_separable_space
  [second_countable_topology α] : separable_space α :=
begin
  choose p hp using λ s : countable_basis α, nonempty_of_mem_countable_basis s.2,
  exact ⟨⟨range p, countable_range _,
    (is_basis_countable_basis α).dense_iff.2 $ λ o ho _, ⟨p ⟨o, ho⟩, hp _, mem_range_self _⟩⟩⟩
end

variables {α}

/-- A countable open cover induces a second-countable topology if all open covers
are themselves second countable. -/
lemma second_countable_topology_of_countable_cover {ι} [encodable ι] {U : ι → set α}
  [∀ i, second_countable_topology (U i)] (Uo : ∀ i, is_open (U i))  (hc : (⋃ i, U i) = univ) :
  second_countable_topology α :=
begin
  have : is_topological_basis (⋃ i, image (coe : U i → α) '' (countable_basis (U i))),
    from is_topological_basis_of_cover Uo hc (λ i, is_basis_countable_basis (U i)),
  exact this.second_countable_topology
    (countable_Union $ λ i, (countable_countable_basis _).image _)
end

/-- In a second-countable space, an open set, given as a union of open sets,
is equal to the union of countably many of those sets. -/
lemma is_open_Union_countable [second_countable_topology α]
  {ι} (s : ι → set α) (H : ∀ i, is_open (s i)) :
  ∃ T : set ι, T.countable ∧ (⋃ i ∈ T, s i) = ⋃ i, s i :=
begin
  let B := {b ∈ countable_basis α | ∃ i, b ⊆ s i},
  choose f hf using λ b : B, b.2.2,
  haveI : encodable B := ((countable_countable_basis α).mono (sep_subset _ _)).to_encodable,
  refine ⟨_, countable_range f, (Union₂_subset_Union _ _).antisymm (sUnion_subset _)⟩,
  rintro _ ⟨i, rfl⟩ x xs,
  rcases (is_basis_countable_basis α).exists_subset_of_mem_open xs (H _) with ⟨b, hb, xb, bs⟩,
  exact ⟨_, ⟨_, rfl⟩, _, ⟨⟨⟨_, hb, _, bs⟩, rfl⟩, rfl⟩, hf _ (by exact xb)⟩
end

lemma is_open_sUnion_countable [second_countable_topology α]
  (S : set (set α)) (H : ∀ s ∈ S, is_open s) :
  ∃ T : set (set α), T.countable ∧ T ⊆ S ∧ ⋃₀ T = ⋃₀ S :=
let ⟨T, cT, hT⟩ := is_open_Union_countable (λ s:S, s.1) (λ s, H s.1 s.2) in
⟨subtype.val '' T, cT.image _,
  image_subset_iff.2 $ λ ⟨x, xs⟩ xt, xs,
  by rwa [sUnion_image, sUnion_eq_Union]⟩

/-- In a topological space with second countable topology, if `f` is a function that sends each
point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
`x ∈ s`, cover the whole space. -/
lemma countable_cover_nhds [second_countable_topology α] {f : α → set α}
  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, s.countable ∧ (⋃ x ∈ s, f x) = univ :=
begin
  rcases is_open_Union_countable (λ x, interior (f x)) (λ x, is_open_interior) with ⟨s, hsc, hsU⟩,
  suffices : (⋃ x ∈ s, interior (f x)) = univ,
    from ⟨s, hsc, flip eq_univ_of_subset this $ Union₂_mono $ λ _ _, interior_subset⟩,
  simp only [hsU, eq_univ_iff_forall, mem_Union],
  exact λ x, ⟨x, mem_interior_iff_mem_nhds.2 (hf x)⟩
end

lemma countable_cover_nhds_within [second_countable_topology α] {f : α → set α} {s : set α}
  (hf : ∀ x ∈ s, f x ∈ 𝓝[s] x) : ∃ t ⊆ s, t.countable ∧ s ⊆ (⋃ x ∈ t, f x) :=
begin
  have : ∀ x : s, coe ⁻¹' (f x) ∈ 𝓝 x, from λ x, preimage_coe_mem_nhds_subtype.2 (hf x x.2),
  rcases countable_cover_nhds this with ⟨t, htc, htU⟩,
  refine ⟨coe '' t, subtype.coe_image_subset _ _, htc.image _, λ x hx, _⟩,
  simp only [bUnion_image, eq_univ_iff_forall, ← preimage_Union, mem_preimage] at htU ⊢,
  exact htU ⟨x, hx⟩
end

section sigma

variables {ι : Type*} {E : ι → Type*} [∀ i, topological_space (E i)]
omit t

/-- In a disjoint union space `Σ i, E i`, one can form a topological basis by taking the union of
topological bases on each of the parts of the space. -/
lemma is_topological_basis.sigma
  {s : Π (i : ι), set (set (E i))} (hs : ∀ i, is_topological_basis (s i)) :
  is_topological_basis (⋃ (i : ι), (λ u, ((sigma.mk i) '' u : set (Σ i, E i))) '' (s i)) :=
begin
  apply is_topological_basis_of_open_of_nhds,
  { assume u hu,
    obtain ⟨i, t, ts, rfl⟩ : ∃ (i : ι) (t : set (E i)), t ∈ s i ∧ sigma.mk i '' t = u,
      by simpa only [mem_Union, mem_image] using hu,
    exact is_open_map_sigma_mk _ ((hs i).is_open ts) },
  { rintros ⟨i, x⟩ u hxu u_open,
    have hx : x ∈ sigma.mk i ⁻¹' u := hxu,
    obtain ⟨v, vs, xv, hv⟩ : ∃ (v : set (E i)) (H : v ∈ s i), x ∈ v ∧ v ⊆ sigma.mk i ⁻¹' u :=
      (hs i).exists_subset_of_mem_open hx (is_open_sigma_iff.1 u_open i),
    exact ⟨(sigma.mk i) '' v, mem_Union.2 ⟨i, mem_image_of_mem _ vs⟩, mem_image_of_mem _ xv,
      image_subset_iff.2 hv⟩ }
end

/-- A countable disjoint union of second countable spaces is second countable. -/
instance [countable ι] [∀ i, second_countable_topology (E i)] :
  second_countable_topology (Σ i, E i) :=
begin
  let b := (⋃ (i : ι), (λ u, ((sigma.mk i) '' u : set (Σ i, E i))) '' (countable_basis (E i))),
  have A : is_topological_basis b := is_topological_basis.sigma (λ i, is_basis_countable_basis  _),
  have B : b.countable := countable_Union (λ i, countable.image (countable_countable_basis _) _),
  exact A.second_countable_topology B,
end

end sigma

section sum
omit t

variables {β : Type*} [topological_space α] [topological_space β]

/-- In a sum space `α ⊕ β`, one can form a topological basis by taking the union of
topological bases on each of the two components. -/
lemma is_topological_basis.sum
  {s : set (set α)} (hs : is_topological_basis s) {t : set (set β)} (ht : is_topological_basis t) :
  is_topological_basis (((λ u, sum.inl '' u) '' s) ∪ ((λ u, sum.inr '' u) '' t)) :=
begin
  apply is_topological_basis_of_open_of_nhds,
  { assume u hu,
    cases hu,
    { rcases hu with ⟨w, hw, rfl⟩,
      exact open_embedding_inl.is_open_map w (hs.is_open hw) },
    { rcases hu with ⟨w, hw, rfl⟩,
      exact open_embedding_inr.is_open_map w (ht.is_open hw) } },
  { rintros x u hxu u_open,
    cases x,
    { have h'x : x ∈ sum.inl ⁻¹' u := hxu,
      obtain ⟨v, vs, xv, vu⟩ : ∃ (v : set α) (H : v ∈ s), x ∈ v ∧ v ⊆ sum.inl ⁻¹' u :=
        hs.exists_subset_of_mem_open h'x (is_open_sum_iff.1 u_open).1,
      exact ⟨sum.inl '' v, mem_union_left _ (mem_image_of_mem _ vs), mem_image_of_mem _ xv,
        image_subset_iff.2 vu⟩ },
    { have h'x : x ∈ sum.inr ⁻¹' u := hxu,
      obtain ⟨v, vs, xv, vu⟩ : ∃ (v : set β) (H : v ∈ t), x ∈ v ∧ v ⊆ sum.inr ⁻¹' u :=
        ht.exists_subset_of_mem_open h'x (is_open_sum_iff.1 u_open).2,
      exact ⟨sum.inr '' v, mem_union_right _ (mem_image_of_mem _ vs), mem_image_of_mem _ xv,
        image_subset_iff.2 vu⟩ } }
end

/-- A sum type of two second countable spaces is second countable. -/
instance [second_countable_topology α] [second_countable_topology β] :
  second_countable_topology (α ⊕ β) :=
begin
  let b := (λ u, sum.inl '' u) '' (countable_basis α) ∪ (λ u, sum.inr '' u) '' (countable_basis β),
  have A : is_topological_basis b := (is_basis_countable_basis α).sum (is_basis_countable_basis β),
  have B : b.countable := (countable.image (countable_countable_basis _) _).union
    (countable.image (countable_countable_basis _) _),
  exact A.second_countable_topology B,
end

end sum

section quotient

variables {X : Type*} [topological_space X] {Y : Type*} [topological_space Y] {π : X → Y}
omit t

/-- The image of a topological basis under an open quotient map is a topological basis. -/
lemma is_topological_basis.quotient_map {V : set (set X)} (hV : is_topological_basis V)
  (h' : quotient_map π) (h : is_open_map π) :
  is_topological_basis (set.image π '' V) :=
begin
  apply is_topological_basis_of_open_of_nhds,
  { rintros - ⟨U, U_in_V, rfl⟩,
    apply h U (hV.is_open U_in_V), },
  { intros y U y_in_U U_open,
    obtain ⟨x, rfl⟩ := h'.surjective y,
    let W := π ⁻¹' U,
    have x_in_W : x ∈ W := y_in_U,
    have W_open : is_open W := U_open.preimage h'.continuous,
    obtain ⟨Z, Z_in_V, x_in_Z, Z_in_W⟩ := hV.exists_subset_of_mem_open x_in_W W_open,
    have πZ_in_U : π '' Z ⊆ U := (set.image_subset _ Z_in_W).trans (image_preimage_subset π U),
    exact ⟨π '' Z, ⟨Z, Z_in_V, rfl⟩, ⟨x, x_in_Z, rfl⟩, πZ_in_U⟩, },
end

/-- A second countable space is mapped by an open quotient map to a second countable space. -/
lemma quotient_map.second_countable_topology [second_countable_topology X] (h' : quotient_map π)
  (h : is_open_map π) :
  second_countable_topology Y :=
{ is_open_generated_countable :=
  begin
    obtain ⟨V, V_countable, V_no_empty, V_generates⟩ := exists_countable_basis X,
    exact ⟨set.image π '' V, V_countable.image (set.image π),
      (V_generates.quotient_map h' h).eq_generate_from⟩,
  end }

variables {S : setoid X}

/-- The image of a topological basis "downstairs" in an open quotient is a topological basis. -/
lemma is_topological_basis.quotient {V : set (set X)}
  (hV : is_topological_basis V) (h : is_open_map (quotient.mk : X → quotient S)) :
  is_topological_basis (set.image (quotient.mk : X → quotient S) '' V) :=
hV.quotient_map quotient_map_quotient_mk h

/-- An open quotient of a second countable space is second countable. -/
lemma quotient.second_countable_topology [second_countable_topology X]
  (h : is_open_map (quotient.mk : X → quotient S)) :
  second_countable_topology (quotient S) :=
quotient_map_quotient_mk.second_countable_topology h

end quotient

end topological_space

open topological_space

variables {α β : Type*} [topological_space α] [topological_space β] {f : α → β}

protected lemma inducing.second_countable_topology [second_countable_topology β]
  (hf : inducing f) : second_countable_topology α :=
by { rw hf.1, exact second_countable_topology_induced α β f }

protected lemma embedding.second_countable_topology [second_countable_topology β]
  (hf : embedding f) : second_countable_topology α :=
hf.1.second_countable_topology


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.default
import Mathlib.group_theory.quotient_group
import Mathlib.group_theory.order_of_element
import Mathlib.data.zmod.basic
import Mathlib.data.fintype.card
import Mathlib.data.list.rotate
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

namespace mul_action

theorem mem_fixed_points_iff_card_orbit_eq_one {G : Type u} {α : Type v} [group G] [mul_action G α] {a : α} [fintype ↥(orbit G a)] : a ∈ fixed_points G α ↔ fintype.card ↥(orbit G a) = 1 := sorry

theorem card_modeq_card_fixed_points {G : Type u} {α : Type v} [group G] [mul_action G α] [fintype α] [fintype G] [fintype ↥(fixed_points G α)] (p : ℕ) {n : ℕ} [hp : fact (nat.prime p)] (h : fintype.card G = p ^ n) : nat.modeq p (fintype.card α) (fintype.card ↥(fixed_points G α)) := sorry

end mul_action

theorem quotient_group.card_preimage_mk {G : Type u} [group G] [fintype G] (s : subgroup G) (t : set (quotient_group.quotient s)) : fintype.card ↥(quotient_group.mk ⁻¹' t) = fintype.card ↥s * fintype.card ↥t := sorry

namespace sylow

/-- Given a vector `v` of length `n`, make a vector of length `n+1` whose product is `1`,
by consing the the inverse of the product of `v`. -/
def mk_vector_prod_eq_one {G : Type u} [group G] (n : ℕ) (v : vector G n) : vector G (n + 1) :=
  list.prod (vector.to_list v)⁻¹::ᵥv

theorem mk_vector_prod_eq_one_injective {G : Type u} [group G] (n : ℕ) : function.injective (mk_vector_prod_eq_one n) := sorry

/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
def vectors_prod_eq_one (G : Type u_1) [group G] (n : ℕ) : set (vector G n) :=
  set_of fun (v : vector G n) => list.prod (vector.to_list v) = 1

theorem mem_vectors_prod_eq_one {G : Type u} [group G] {n : ℕ} (v : vector G n) : v ∈ vectors_prod_eq_one G n ↔ list.prod (vector.to_list v) = 1 :=
  iff.rfl

theorem mem_vectors_prod_eq_one_iff {G : Type u} [group G] {n : ℕ} (v : vector G (n + 1)) : v ∈ vectors_prod_eq_one G (n + 1) ↔ v ∈ set.range (mk_vector_prod_eq_one n) := sorry

/-- The rotation action of `zmod n` (viewed as multiplicative group) on
`vectors_prod_eq_one G n`, where `G` is a multiplicative group. -/
def rotate_vectors_prod_eq_one (G : Type u_1) [group G] (n : ℕ) (m : multiplicative (zmod n)) (v : ↥(vectors_prod_eq_one G n)) : ↥(vectors_prod_eq_one G n) :=
  { val := { val := list.rotate (vector.to_list (subtype.val v)) (zmod.val m), property := sorry }, property := sorry }

protected instance rotate_vectors_prod_eq_one.mul_action {G : Type u} [group G] (n : ℕ) [fact (0 < n)] : mul_action (multiplicative (zmod n)) ↥(vectors_prod_eq_one G n) :=
  mul_action.mk sorry sorry

theorem one_mem_vectors_prod_eq_one {G : Type u} [group G] (n : ℕ) : vector.repeat 1 n ∈ vectors_prod_eq_one G n := sorry

theorem one_mem_fixed_points_rotate {G : Type u} [group G] (n : ℕ) [fact (0 < n)] : { val := vector.repeat 1 n, property := one_mem_vectors_prod_eq_one n } ∈
  mul_action.fixed_points (multiplicative (zmod n)) ↥(vectors_prod_eq_one G n) := sorry

/-- Cauchy's theorem -/
theorem exists_prime_order_of_dvd_card {G : Type u} [group G] [fintype G] (p : ℕ) [hp : fact (nat.prime p)] (hdvd : p ∣ fintype.card G) : ∃ (x : G), order_of x = p := sorry

theorem mem_fixed_points_mul_left_cosets_iff_mem_normalizer {G : Type u} [group G] {H : subgroup G} [fintype ↥↑H] {x : G} : ↑x ∈ mul_action.fixed_points (↥H) (quotient_group.quotient H) ↔ x ∈ subgroup.normalizer H := sorry

def fixed_points_mul_left_cosets_equiv_quotient {G : Type u} [group G] (H : subgroup G) [fintype ↥↑H] : ↥(mul_action.fixed_points (↥H) (quotient_group.quotient H)) ≃
  quotient_group.quotient (subgroup.comap (subgroup.subtype (subgroup.normalizer H)) H) :=
  equiv.subtype_quotient_equiv_quotient_subtype (↑(subgroup.normalizer H))
    (mul_action.fixed_points (↥H)
      (quotient (id (setoid.mk (fun (x y : G) => x⁻¹ * y ∈ H) (quotient_group.left_rel._proof_1 H)))))
    sorry sorry

theorem exists_subgroup_card_pow_prime {G : Type u} [group G] [fintype G] (p : ℕ) {n : ℕ} [hp : fact (nat.prime p)] (hdvd : p ^ n ∣ fintype.card G) : ∃ (H : subgroup G), fintype.card ↥H = p ^ n := sorry


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.rbtree.basic

universes u

namespace Mathlib

namespace rbnode

theorem mem_of_min_eq {α : Type u} (lt : α → α → Prop) [is_irrefl α lt] {a : α} {t : rbnode α} : rbnode.min t = some a → mem lt a t := sorry

theorem mem_of_max_eq {α : Type u} (lt : α → α → Prop) [is_irrefl α lt] {a : α} {t : rbnode α} : rbnode.max t = some a → mem lt a t := sorry

theorem eq_leaf_of_min_eq_none {α : Type u} {t : rbnode α} : rbnode.min t = none → t = leaf := sorry

theorem eq_leaf_of_max_eq_none {α : Type u} {t : rbnode α} : rbnode.max t = none → t = leaf := sorry

theorem min_is_minimal {α : Type u} {lt : α → α → Prop} [DecidableRel lt] [is_strict_weak_order α lt] {a : α} {t : rbnode α} {lo : Option α} {hi : Option α} : is_searchable lt t lo hi → rbnode.min t = some a → ∀ {b : α}, mem lt b t → strict_weak_order.equiv a b ∨ lt a b := sorry

theorem max_is_maximal {α : Type u} {lt : α → α → Prop} [DecidableRel lt] [is_strict_weak_order α lt] {a : α} {t : rbnode α} {lo : Option α} {hi : Option α} : is_searchable lt t lo hi → rbnode.max t = some a → ∀ {b : α}, mem lt b t → strict_weak_order.equiv a b ∨ lt b a := sorry


import SciLean
import SciLean.Tactic.Basic

open SciLean

variable {I₁ I₂ I₃ I₄ : Type}
variable [Enumtype I₁] [Enumtype I₂] [Enumtype I₃] [Enumtype I₄]
variable [Nonempty I₁] [Nonempty I₂] [Nonempty I₃] [Nonempty I₄]

--  ___           _     _
-- | _ \__ _ _ _ | |__ / |
-- |   / _` | ' \| / / | |
-- |_|_\__,_|_||_|_\_\ |_|

example (i : I₁)
  : (λ (f : I₁ → ℝ) => f i)†
    =
    λ f' i' => kron i i' * f' :=
by
  conv => lhs; simp
  done

--  ___           _     ___
-- | _ \__ _ _ _ | |__ |_  )
-- |   / _` | ' \| / /  / /
-- |_|_\__,_|_||_|_\_\ /___|

-- Full evaluate
example (i j)
  : (λ (f : I₁ → I₂ → ℝ) => f i j)†
    =
    λ (f' : ℝ) i' j' => kron i i' * kron j j' * f' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

-- Get i-th row
example (i)
  : (λ (f : I₁ → I₂ → ℝ) j => f i j)†
    =
    λ (f' : I₂ → ℝ) i' j' => kron i i' * f' j' :=
by
  conv => lhs; simp
  done

-- Get j-th column
example (j)
  : (λ (f : I₁ → I₂ → ℝ) i => f i j)†
    =
    λ (f' : I₁ → ℝ) i' j' => kron j j' * f' i' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

-- Transpose
example
  : (λ (f : I₁ → I₂ → ℝ) j i => f i j)†
    =
    λ (f' : I₂ → I₁ → ℝ) i' j' => f' j' i' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

-- Take diagonal
example
  : (λ (f : I₁ → I₁ → ℝ) i => f i i)†
    =
    λ (f' : I₁ → ℝ) i' j' => kron i' j' * f' i' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

--  ___           _     ____
-- | _ \__ _ _ _ | |__ |__ /
-- |   / _` | ' \| / /  |_ \
-- |_|_\__,_|_||_|_\_\ |___/

-- Full evaluate
example (i j k)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) => f i j k)†
    =
    λ f' i' j' k' => kron i i' * kron j j' * kron k k' * f' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

-- Fix i
example (i)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) j k => f i j k)†
    =
    λ f' i' j' k' => kron i i' * f' j' k' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

-- Fix j
example (j)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) i k => f i j k)†
    =
    λ f' i' j' k' => kron j j' * f' i' k' :=
by
  conv =>
    lhs
    repeat' ext
    simp
    rw [sum_swap]
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
    simp only [CommRing.mul_comm (kron j _) _]
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
  done

-- Fix k
example (k)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) i j => f i j k)†
    =
    λ f' i' j' k' => kron k k' * f' i' j' :=
by
  conv =>
    lhs
    repeat' ext
    simp
    rw [sum_swap]
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
  done

-- Fix j k
example (j k)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) i => f i j k)†
    =
    λ f' i' j' k' => kron j j' * kron k k' * f' i' :=
by
  conv =>
    lhs
    repeat' ext
    simp
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
  done

-- Fix i k
example (i k)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) j => f i j k)†
    =
    λ f' i' j' k' => kron i i' * kron k k' * f' j' :=
by
  conv =>
    lhs
    repeat' ext
    simp
    simp only [CommRing.mul_comm (kron i _) _]
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
  done

-- Fix i j
example (i j)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) k => f i j k)†
    =
    λ f' i' j' k' => kron i i' * kron j j' * f' k' :=
by
  conv =>
    lhs
    repeat' ext
    simp
    simp only [CommRing.mul_comm (kron i _ * kron j _) _]
    simp only [kron_smul_assoc, sum_of_kron_2]
    simp
  done

-- Fix i and transpose
set_option trace.Meta.Tactic.simp.discharge true in
example (i)
  : (λ (f : I₁ → I₂ → I₃ → ℝ) k j => f i j k)†
    =
    λ f' i' j' k' => kron i i' * f' k' j' :=
by
  conv =>
    lhs
    repeat' ext
    simp
  done

#exit


import types

inductive formula (ι : Type)  (gri : ground_interpretation ι)
| prime (p : Prop) [decidable p] : formula
| conjunction : formula → formula → formula
| disjunction : formula → formula → formula
| implication : formula → formula → formula
| universal {σ : type ι gri} : (∥σ∥ → formula) → formula
| existential {σ : type ι gri} : (∥σ∥ → formula) → formula

inductive restricted_formula (ι : Type)  (gri : ground_interpretation ι)

section basics

  namespace formula

  infixr `⟹` : 45 := implication
  infix `⋀` : 50 := conjunction
  infix `⋁` : 50 := disjunction
  notation `universal'` := @universal _ _
  notation `existential'` := @existential _ _
  -- how does this actually work?
  notation `∀∀` binders `,` r:(scoped A, universal A) := r
  notation `∃∃` binders  `,` r:(scoped A, existential A) := r

  @[reducible, simp] def falsum (ι : Type) (gri : ground_interpretation ι) : formula ι gri := @prime ι gri false _
  @[reducible, simp] def falsum' {ι : Type} {gri : ground_interpretation ι} : formula ι gri := falsum _ _

  variables {ι : Type} {gri : ground_interpretation ι}

  local notation `𝕋` := type ι gri
  local notation `𝔽` := formula ι gri

  instance : has_bot 𝔽 := ⟨falsum ι gri⟩

  def negation (A : 𝔽) := A ⟹ falsum ι gri
  prefix `∼` : 90 := negation

  def equivalence (A B : 𝔽) := A ⟹ B ⋀ B ⟹ A
  infixl `⇔` : 15 := equivalence

  @[simp]
  def eqext (greq : Π {i : ι}, ∥𝕏 i∥ → ∥𝕏 i∥ → 𝔽) : Π {σ : 𝕋}, ∥σ∥ → ∥σ∥ → 𝔽
  | 𝕆 x y := prime $ x = y
  | (𝕏 i) x y := greq x y
  | (σ ↣ τ) x y := ∀∀ z : ∥σ∥ , (eqext (x z) (y z))
  | (σ ⊗ τ) x y := eqext x.1 y.1 ⋀ eqext x.2 y.2

  @[simp, pp_nodot]
  def interpret : 𝔽 → Prop
  | (@prime _ _ p _) := p
  | (A ⋀ B) := A.interpret ∧ B.interpret
  | (A ⋁ B) := A.interpret ∨ B.interpret
  | (A ⟹ B) := A.interpret → B.interpret
  | (universal' σ A) := ∀ x : ∥σ∥, (A x).interpret
  | (existential' σ A) := ∃ x : ∥σ∥, (A x).interpret

  -- @[simp]
  -- lemma prime_interpret (p : Prop) [decidable p] : ∥(prime p : 𝔽)∥ ↔ p :=
  -- by split; intros; simpa

  notation `∥` A `∥` := interpret A

  end formula

end basics

section kinds_of_formulas

  variables {ι : Type}  {gri : ground_interpretation ι}
  local notation `𝕋` := type ι gri
  local notation `𝔽` := formula ι gri
  variables {greq : Π {i : ι}, ∥𝕏 i // gri∥ → ∥𝕏 i // gri∥ → 𝔽}

  namespace formula

  @[simp]
  def is_qf : 𝔽 → Prop
  | (@prime _ _ _ _) := true
  | (A ⋀ B) := and A.is_qf B.is_qf
  | (A ⋁ B) := and A.is_qf B.is_qf
  | (A ⟹ B) := and A.is_qf B.is_qf
  | (universal' σ A) := false
  | (existential' σ A) := false

  @[simp]
  def is_qf_disj_free : 𝔽 → Prop
  | (@prime _ _ _ _) := true
  | (A ⋀ B) := and A.is_qf_disj_free B.is_qf_disj_free
  | (A ⋁ B) := false
  | (A ⟹ B) := and A.is_qf_disj_free B.is_qf_disj_free
  | (universal' σ A) := false
  | (existential' σ A) := false

  inductive purely_univ : 𝔽 → Type
  | of_qf (A : 𝔽) : A.is_qf → purely_univ A
  | of_univ {σ : 𝕋} (A : ∥σ∥ → 𝔽) : (∀ x : ∥σ∥, purely_univ (A x)) → purely_univ (universal' σ A)

  def is_purely_univ : 𝔽 → Prop
  | (@prime _ _ _ _) := true
  | (A ⋀ B) := A.is_qf ∧ B.is_qf
  | (A ⋁ B) := A.is_qf ∧ B.is_qf
  | (A ⟹ B) := A.is_qf ∧ B.is_qf
  | (universal' σ A) := ∀ x, is_purely_univ (A x)
  | (existential' σ A) := false

  inductive purely_univ_disj_free : 𝔽 → Type
  | of_qf_disj_free (A : 𝔽) : A.is_qf_disj_free → purely_univ_disj_free A
  | of_univ {σ : 𝕋} (A : ∥σ∥ → 𝔽) : (∀ x : ∥σ∥, purely_univ_disj_free (A x)) → purely_univ_disj_free (universal' σ A)

  end formula

end kinds_of_formulas


-- Useful bounds

import analysis.special_functions.log.deriv
import data.real.basic
import data.real.ennreal
import data.real.nnreal
import data.real.pi.bounds
import data.set.basic
import tactic.field_simp
import topology.metric_space.basic

import simple
import tactics

open complex (abs exp log I)
open filter (at_top)
open_locale real nnreal topological_space

-- A finset ℕ with only large elements
def late (N : finset ℕ) (m : ℕ) := ∀ n, n ∈ N → n ≥ m

def sdiff_late {m : ℕ} {B : finset ℕ} (A : finset ℕ) : B ≥ finset.range m → late (A \ B) m := begin
  intros Bm n nAB,
  rw finset.mem_sdiff at nAB,
  by_contradiction, simp at h,
  have nr := finset.mem_range.mpr h,
  have nB := finset.mem_of_subset Bm nr,
  finish
end

-- Summing a subset of a geometric series is ≤ the series sum
theorem partial_geometric_bound {a : ℝ} (N : finset ℕ) (a0 : a ≥ 0) (a1 : a < 1)
    : N.sum (λ n, a^n) ≤ (1 - a)⁻¹ := begin
  have pos : ∀ n, n ∉ N → 0 ≤ a^n, { intros n nN, exact pow_nonneg a0 n },
  exact sum_le_has_sum N pos (has_sum_geometric_of_lt_1 a0 a1)
end

-- Summing a subset of a scaled_geometric series is ≤ the series sum
theorem partial_scaled_geometric_bound {a : ℝ} (c : ℝ≥0) (N : finset ℕ) (a0 : a ≥ 0) (a1 : a < 1)
    : N.sum (λ n, (c : ℝ) * a^n) ≤ c * (1 - a)⁻¹ := begin
  rw ←finset.mul_sum,
  have h := partial_geometric_bound N a0 a1,
  bound
end

-- Summing a late part of a series is equivalent to summing a shifted series
lemma late_series_sum {m : ℕ} {N : finset ℕ} (h : late N m) (f : ℕ → ℝ)
    : N.sum f = (finset.image (λ n, n - m) N).sum (λ n, f (n + m)) := begin
  set Ns := finset.image (λ n, n - m) N,
  have NNs : N = finset.image (λ n, n + m) Ns, {
    apply finset.ext, intro k,
    rw [finset.image_image, finset.mem_image],
    simp,
    apply iff.intro, {
      intro kN, existsi k, apply and.intro,
      assumption, exact nat.sub_add_cancel (h k kN)
    }, {
      intro ha, rcases ha with ⟨a,aN,ak⟩,
      rw nat.sub_add_cancel (h a aN) at ak,
      rw ←ak, assumption
    }
  },
  rw NNs, apply finset.sum_image,
  intros a aN b bN, exact nat.add_right_cancel
end

-- late_series_sum, but forget the image set
lemma late_series_sum' {m : ℕ} {N : finset ℕ} (h : late N m) (f : ℕ → ℝ)
    : ∃ M : finset ℕ, N.sum f = M.sum (λ n, f (n + m)) := begin
  existsi finset.image (λ n, n - m) N,
  exact late_series_sum h f
end

-- Summing a late subset of a geometric series is even smaller
theorem late_geometric_bound {m : ℕ} {a : ℝ} {N : finset ℕ}
    (h : late N m) (a0 : a ≥ 0) (a1 : a < 1)
    : N.sum (λ n, a^n) ≤ a^m * (1 - a)⁻¹ := begin
  rcases late_series_sum' h (λ n, a^n) with ⟨M, L⟩,
  rw L, clear L, simp,
  have pa : (λ n, a^(n + m)) = (λ n, a^n * a^m), { apply funext, intro n, rw pow_add },
  calc M.sum (λ n, a^(n + m)) = M.sum (λ n, a^n * a^m) : by rw pa
  ... = M.sum (λ n, (λ n, a^n) n * a^m) : by simp
  ... = M.sum (λ n, a^n) * a^m : (@finset.sum_mul _ _ M (a^m) (λ n, a^n) _).symm
  ... ≤ (1 - a)⁻¹ * a^m : by bound [partial_geometric_bound M a0 a1]
  ... = a^m * (1 - a)⁻¹ : by ring
end

lemma finset_partition (A B : finset ℕ) : A = (A \ B) ∪ (A ∩ B) := begin
  apply finset.ext, intro a,
  apply iff.intro, {
    finish
  }, {
    rw [finset.mem_union, finset.mem_inter, finset.mem_sdiff],
    finish
  }
end

lemma finset_sum_partition (A B : finset ℕ) (f : ℕ → ℂ)
    : A.sum (λ n, f n) = (A \ B).sum (λ n, f n) + (A ∩ B).sum (λ n, f n) := begin
  have ha : A = (A \ B) ∪ (A ∩ B) := finset_partition A B,
  nth_rewrite 0 ha,
  exact finset.sum_union (finset.disjoint_sdiff_inter A B)
end

lemma sdiff_sdiff_disjoint (A B : finset ℕ) : disjoint (A \ B) (B \ A) :=
  finset.disjoint_of_subset_right (finset.sdiff_subset B A) finset.sdiff_disjoint

lemma symm_diff_union (A B : finset ℕ) : A ∆ B = A \ B ∪ B \ A :=
  by rw [symm_diff_def, finset.sup_eq_union]

-- Bound the difference of two finset sums based on their symmetric difference
theorem symm_diff_bound (A B : finset ℕ) (f : ℕ → ℂ)
    : dist (A.sum (λ n, f n)) (B.sum (λ n, f n)) ≤ (A ∆ B).sum (λ n, abs (f n)) := begin
  rw finset_sum_partition A B f,
  rw finset_sum_partition B A f,
  rw finset.inter_comm B A,
  rw dist_add_right ((A\B).sum (λn,f n)) ((B\A).sum (λn,f n)) ((A∩B).sum (λn,f n)),
  rw complex.dist_eq,
  transitivity (A \ B).sum (λ n, abs (f n)) + (B \ A).sum (λ n, abs (f n)), {
    have ha := simple.finset_complex_abs_sum_le (A \ B) f,
    have hb := simple.finset_complex_abs_sum_le (B \ A) f,
    calc abs ((A \ B).sum (λ n, f n) - (B \ A).sum (λ n, f n))
        ≤ abs ((A \ B).sum (λ n, f n)) + abs ((B \ A).sum (λ n, f n)) : simple.abs_sub'
    ... ≤ (A \ B).sum (λ n, abs (f n)) + (B \ A).sum (λ n, abs (f n)) : by bound [ha, hb]
  }, {
    apply le_of_eq,
    rw [←finset.sum_union (sdiff_sdiff_disjoint A B), symm_diff_union]
  }
end

-- Symmetric differences of sets containing ranges are late
theorem symm_diff_late {A B : finset ℕ} {m : ℕ} (ha : A ≥ finset.range m) (hb : B ≥ finset.range m)
    : late (A ∆ B) m := begin
  intros n ab,
  rw [symm_diff_def, finset.sup_eq_union, finset.mem_union] at ab,
  by_contradiction, simp at h,
  cases ab, {
    rw finset.mem_sdiff at ab,
    have h := finset.mem_of_subset hb (finset.mem_range.mpr h),
    finish
  }, {
    rw finset.mem_sdiff at ab,
    have h := finset.mem_of_subset ha (finset.mem_range.mpr h),
    finish
  }
end

lemma sub_near (a z : ℂ) : |abs (a - z) - abs a| ≤ abs z := begin
  rw abs_le, constructor, {
    simp, flip_ineq,
    calc abs (a - z) + abs z ≥ |abs a - abs z| + abs z : by bound [complex.abs_abs_sub_le_abs_sub a z]
    ... ≥ abs a - abs z + abs z : by bound [le_abs_self (abs a - abs z)]
    ... = abs a : by simp
  }, {
    calc abs (a - z) - abs a ≤ abs a + abs z - abs a : by bound
    ... = abs z : by simp
  }
end

lemma add_near (a z : ℂ) : |abs (a + z) - abs a| ≤ abs z := begin
  have h := sub_near a (-z),
  simp at h,
  assumption
end

lemma near_one_avoids_negative_reals {z : ℂ} : abs (z - 1) < 1 → z.re > 0 ∨ z.im ≠ 0 := begin
  intro h, apply or.inl,
  have hr : (1 - z).re < 1, {
    calc (1 - z).re ≤ |(1 - z).re| : le_abs_self (1 - z).re
    ... ≤ abs (1 - z) : complex.abs_re_le_abs _
    ... = abs (z - 1) : by { rw ←complex.abs_neg (1 - z), simp }
    ... < 1 : h
  },
  simp at hr, assumption
end

lemma near_one_avoids_zero {z : ℂ} : abs (z - 1) < 1 → z ≠ 0 := begin
  intro h,
  have g := near_one_avoids_negative_reals h,
  by_contradiction, rw h at g, simp at g, assumption
end

theorem deriv_within.cid {z : ℂ} {s : set ℂ}
    (o : is_open s) (zs : z ∈ s) : deriv_within (λ z, z) s z = 1 :=
  deriv_within_id z s (is_open.unique_diff_within_at o zs)

theorem deriv_within.clog {f : ℂ → ℂ} {z : ℂ} {s : set ℂ}
    (o : is_open s) (zs : z ∈ s)
    (hf : differentiable_within_at ℂ f s z) (hx : (f z).re > 0 ∨ (f z).im ≠ 0)
    : deriv_within (λ z, log (f z)) s z = deriv_within f s z / f z := begin
  have hz := differentiable_within_at.has_deriv_within_at hf,
  have h := has_deriv_within_at.clog hz _,
  repeat { rw has_deriv_within_at.deriv_within },
  repeat { assumption <|> exact is_open.unique_diff_within_at o zs }
end

theorem differentiable_on.cpow {f : ℂ → ℂ} {g : ℂ → ℂ} {s : set ℂ}
    (df : differentiable_on ℂ f s)
    (dg : differentiable_on ℂ g s)
    (h : ∀ z, z ∈ s → 0 < (f z).re ∨ (f z).im ≠ 0)
    : differentiable_on ℂ (λ z, f z ^ g z) s := begin
  intros z zs,
  exact differentiable_within_at.cpow (df z zs) (dg z zs) (h z zs)
end

-- log (1+z) is small for small z (complex case, assuming strict inequality)
theorem weak_log1p_small {z : ℂ} {r : ℝ} (r1 : r < 1) (h : abs z < r)
    : abs (log (1+z)) ≤ 1 / (1 - r) * abs z := begin
  by_cases rp : r ≤ 0, {
    have a0 : abs z < 0 := lt_of_lt_of_le h rp,
    have a0' : abs z ≥ 0 := by bound,
    linarith
  }, {
    simp at rp,
    have L : ∥log (1+z) - log 1∥ ≤ 1 / (1-r) * ∥1+z-1∥, {
      set s := metric.ball (1 : ℂ) r,
      have o : is_open s := metric.is_open_ball,
      have s1z : (1+z) ∈ s, { simp, assumption },
      have s1 : (1 : ℂ) ∈ s := by { simp, assumption },
      have sp : ∀ w : ℂ, w ∈ s → w.re > 0 ∨ w.im ≠ 0, {
        intros w ws,
        apply near_one_avoids_negative_reals,
        simp at ws, rw complex.dist_eq at ws,
        calc abs (w - 1) < r : by assumption
        ... < 1 : r1
      },
      have sa : ∀ w : ℂ, w ∈ s → abs w ≥ 1 - r, {
        intros w ws, simp at ws, rw complex.dist_eq at ws,
        calc abs w = abs (1 + (w - 1)) : by ring_nf
        ... ≥ abs (1 : ℂ) - abs (w - 1) : by bound
        ... ≥ abs (1 : ℂ) - r : by bound
        ... = 1 - r : by rw complex.abs_one
      },
      refine convex.norm_image_sub_le_of_norm_deriv_within_le _ _ _ s1 s1z, {
        exact differentiable_on.clog differentiable_on_id sp
      }, {
        intros w ws,
        rw [deriv_within.clog o ws, deriv_within.cid o ws],
        simp, rw inv_le, have aw := sa w ws, simp at aw, field_simp, assumption,
        have aw := sa w ws, linarith, norm_num,
        assumption,
        exact differentiable_within_at_id,
        exact sp w ws
      }, {
        exact convex_ball _ _
      }
    },
    simp at L, simp, assumption
  }
end

-- To show a ≤ b, it suffices to show a ≤ b + e for small positive e
lemma le_of_forall_small_le_add {a b t : ℝ}
    (tp : t > 0) (h : ∀ e, 0 < e → e < t → a ≤ b + e) : a ≤ b := begin
  apply le_of_forall_pos_lt_add,
  intros e ep,
  by_cases et : e ≥ t, {
    specialize h (t/2) (by bound) (by bound),
    calc a ≤ b + t/2 : h
    ... ≤ b + e/2 : by bound
    ... < b + e : by bound
  }, {
    simp at et,
    calc a ≤ b + e/2 : h (e/2) (by bound) (by linarith)
    ... < b + e : by bound
  }
end

-- 1 / (1 - x) ≤ 1 + 2*x for small positive x
theorem one_over_one_sub_le {x : ℝ} : 0 ≤ x → x ≤ 1/2 → 1 / (1 - x) ≤ 1 + 2*x := begin
  intros xp xh,
  have x1 : 1 - x > 0 := by linarith,
  rw div_le_iff x1,
  flip_ineq,
  calc (1 + 2*x) * (1 - x) = 1 + x*(1 - 2*x) : by ring
  ... ≥ 1 + x*(1 - 2*(1/2)) : by bound
  ... = 1 : by ring
end

-- Version of metric.continuous_at_iff.mp which provides an upper bound on the radius.
-- This makes downstream usage more convenient in some cases.
lemma metric.continuous_near {f : ℂ → ℂ} {z : ℂ} {r : ℝ}
    (fc : continuous_at f z) (rp : r > 0)
    : ∀ e, e > 0 → ∃ s, 0 < s ∧ s ≤ r ∧ ∀ {w}, abs (w - z) < s → abs (f w - f z) < e := begin
  intros e ep,
  rcases metric.continuous_at_iff.mp fc e ep with ⟨s,sp,sc⟩,
  simp_rw complex.dist_eq at sc,
  by_cases sr : s ≤ r, { existsi s, exact ⟨sp,sr,λ w wr, sc wr⟩ },
  simp at sr, existsi r, refine ⟨rp, by bound, _⟩,
  intros w wr, refine @sc w _,
  transitivity r, assumption, assumption
end

-- Given z ≠ 0, we can find a slightly smaller nearby w
lemma slightly_smaller {z : ℂ} (nz : z ≠ 0) {r : ℝ} : r > 0 → ∃ w, abs (w - z) < r ∧ abs w < abs z := begin
  intro rp,
  by_cases rz : r > abs z, {
    existsi (0 : ℂ), simp, finish
  },
  simp at rz,
  have azp : abs z > 0 := complex.abs_pos.mpr nz,
  generalize ha : 1 - r / 2 / abs z = a,
  have a0 : a ≥ 0, {
    rw ←ha, refine sub_nonneg.mpr ((div_le_one azp).mpr _),
    transitivity r, bound, assumption
  },
  have a1 : a < 1, { rw ←ha, simp, bound },
  generalize hw : ↑a * z = w,
  existsi w, constructor, {
    rw [←hw,←ha], simp, rw mul_sub_right_distrib, simp,
    rw [abs_of_pos rp, div_mul (r / 2), div_self (ne_of_gt azp)],
    simp, bound
  }, {
    rw ←hw, simp, rw abs_of_nonneg a0,
    calc a * abs z < 1 * abs z : mul_lt_mul_of_pos_right a1 azp
    ... = abs z : by ring
  }
end

-- Turn a weak small theorem into a strong small theorem
lemma weak_to_strong_small {f : ℂ → ℂ} {z : ℂ} {r c : ℝ}
    (rp : r > 0) (cp : c > 0) (zr : abs z ≤ r) (fc : continuous_at f z)
    (h : ∀ z : ℂ, abs z < r → abs (f z) ≤ c * abs z)
    : abs (f z) ≤ c * abs z := begin
  by_cases nz : z = 0, { refine h z _, rw nz, simpa },
  apply le_of_forall_small_le_add zero_lt_one,
  intros e ep e1,
  rcases metric.continuous_near fc rp e ep with ⟨s,sp,sr,sc⟩,
  rcases slightly_smaller nz sp with ⟨w,wz,awz⟩,
  have wr : abs w < r := lt_of_lt_of_le awz zr,
  calc abs (f z) = abs (f w - (f w - f z)) : by ring_nf
  ... ≤ abs (f w) + abs (f w - f z) : simple.abs_sub _ _
  ... ≤ c * abs w + e : by bound [h w wr, sc wz]
  ... ≤ c * abs z + e : by bound
end

-- log (1+z) is small for small z
theorem log1p_small {z : ℂ} (zs : abs z ≤ 1/2) : abs (log (1+z)) ≤ 2 * abs z := begin
  have rp : (1/2 : ℝ) > 0 := by norm_num,
  have cp : (2 : ℝ) > 0 := by norm_num,
  have fc : continuous_at (λ z, log (1 + z)) z, {
    apply continuous_at.clog, apply continuous_at.add,
    exact continuous_at_const, exact continuous_at_id,
    refine near_one_avoids_negative_reals _,
    simp, exact lt_of_le_of_lt zs (by bound)
  },
  apply weak_to_strong_small rp cp zs fc,
  intros w wr,
  have ws := @weak_log1p_small w (1/2) (by bound) wr,
  have t : 1 / (1 - 1 / 2) = (2 : ℝ) := by norm_num,
  rw t at ws, simpa
end

-- log z is small for z ≈ 1
theorem log_small {z : ℂ} (zs : abs (z - 1) ≤ 1/2) : abs (log z) ≤ 2 * abs (z - 1) := begin
  generalize zw : z - 1 = z1, have wz : z = 1 + z1, { rw ←zw, ring },
  rw wz, refine log1p_small _, rw ←zw, assumption
end

-- exp z ≈ 1 for z ≈ 0, strict inequality version
theorem weak_exp_small {z : ℂ} (h : abs z < 1) : abs (exp z - 1) ≤ 2 * abs z := begin
  have hr : 0 ≤ (1 : ℝ) := by norm_num,
  have L := complex.locally_lipschitz_exp hr (by bound) 0 z (by { simp, assumption }),
  simp at L,
  have t : 1 + 1 = (2 : ℝ) := by norm_num,
  rw t at L, assumption
end

-- exp z ≈ 1 for z ≈ 0
theorem exp_small {z : ℂ} (zs : abs z ≤ 1) : abs (exp z - 1) ≤ 2 * abs z := begin
  have rp : (1 : ℝ) > 0 := by norm_num,
  have cp : (2 : ℝ) > 0 := by norm_num,
  have fc : continuous_at (λ z, exp z - 1) z, {
    apply continuous_at.sub, apply continuous_at.cexp,
    exact continuous_at_id, exact continuous_at_const
  },
  apply weak_to_strong_small rp cp zs fc,
  intros w wr, simp,
  exact weak_exp_small wr,
end

-- abs ((1+z)^w - 1) ≤ 2 * abs (zw) for small z,w
theorem pow1p_small {z w : ℂ} (zs : abs z ≤ 1/2) (ws : abs w ≤ 1)
    : abs ((1+z)^w - 1) ≤ 4 * abs z * abs w := begin
  have z1 : 1 + z ≠ 0, {
    rw ←complex.abs_ne_zero, apply ne_of_gt, flip_ineq,
    calc abs (1 + z) ≥ abs (1 : ℂ) - abs z : by bound
    ... ≥ abs (1 : ℂ) - 1/2 : by bound
    ... > 0 : by norm_num
  },
  rw complex.cpow_def_of_ne_zero z1,
  have ls := log1p_small zs,
  have eas : abs (log (1 + z) * w) ≤ 1, {
    rw complex.abs_mul,
    calc abs (log (1 + z)) * abs w ≤ 2 * abs z * abs w : by bound
    ... ≤ 2 * (1/2) * 1 : by bound
    ... = 1 : by norm_num
  },
  have es := exp_small eas,
  rw [complex.abs_mul, ←mul_assoc] at es,
  transitivity 2 * abs (log (1 + z)) * abs w,
  assumption,
  calc 2 * abs (log (1 + z)) * abs w ≤ 2 * (2 * abs z) * abs w : by bound
  ... = 4 * abs z * abs w : by ring
end

-- abs (z^w - 1) ≤ 2 * abs ((z-1)w) for z ≈ 1, w small
theorem pow_small {z w : ℂ} (zs : abs (z - 1) ≤ 1/2) (ws : abs w ≤ 1)
    : abs (z^w - 1) ≤ 4 * abs (z - 1) * abs w := begin
  generalize zw : z - 1 = z1, have wz : z = 1 + z1, { rw ←zw, ring },
  rw wz, refine pow1p_small _ ws, rw ←zw, assumption
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Chris Hughes

! This file was ported from Lean 3 source module ring_theory.integral_domain
! leanprover-community/mathlib commit 6e70e0d419bf686784937d64ed4bfde866ff229e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.RingDivision
import Mathbin.GroupTheory.SpecificGroups.Cyclic
import Mathbin.Algebra.GeomSum

/-!
# Integral domains

Assorted theorems about integral domains.

## Main theorems

* `is_cyclic_of_subgroup_is_domain`: A finite subgroup of the units of an integral domain is cyclic.
* `fintype.field_of_domain`: A finite integral domain is a field.

## TODO

Prove Wedderburn's little theorem, which shows that all finite division rings are actually fields.

## Tags

integral domain, finite integral domain, finite field
-/

section

open Finset Polynomial Function

open BigOperators Nat

section CancelMonoidWithZero

-- There doesn't seem to be a better home for these right now
variable {M : Type _} [CancelMonoidWithZero M] [Finite M]

theorem mul_right_bijective_of_finite₀ {a : M} (ha : a ≠ 0) : Bijective fun b => a * b :=
  Finite.injective_iff_bijective.1 <| mul_right_injective₀ ha
#align mul_right_bijective_of_finite₀ mul_right_bijective_of_finite₀

theorem mul_left_bijective_of_finite₀ {a : M} (ha : a ≠ 0) : Bijective fun b => b * a :=
  Finite.injective_iff_bijective.1 <| mul_left_injective₀ ha
#align mul_left_bijective_of_finite₀ mul_left_bijective_of_finite₀

/-- Every finite nontrivial cancel_monoid_with_zero is a group_with_zero. -/
def Fintype.groupWithZeroOfCancel (M : Type _) [CancelMonoidWithZero M] [DecidableEq M] [Fintype M]
    [Nontrivial M] : GroupWithZero M :=
  { ‹Nontrivial M›,
    ‹CancelMonoidWithZero
        M› with
    inv := fun a => if h : a = 0 then 0 else Fintype.bijInv (mul_right_bijective_of_finite₀ h) 1
    mul_inv_cancel := fun a ha => by
      simp [Inv.inv, dif_neg ha]
      exact Fintype.rightInverse_bijInv _ _
    inv_zero := by simp [Inv.inv, dif_pos rfl] }
#align fintype.group_with_zero_of_cancel Fintype.groupWithZeroOfCancel

theorem exists_eq_pow_of_mul_eq_pow_of_coprime {R : Type _} [CommSemiring R] [IsDomain R]
    [GCDMonoid R] [Unique Rˣ] {a b c : R} {n : ℕ} (cp : IsCoprime a b) (h : a * b = c ^ n) :
    ∃ d : R, a = d ^ n :=
  by
  refine' exists_eq_pow_of_mul_eq_pow (isUnit_of_dvd_one _ _) h
  obtain ⟨x, y, hxy⟩ := cp
  rw [← hxy]
  exact
    dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left _ _) _) (dvd_mul_of_dvd_right (gcd_dvd_right _ _) _)
#align exists_eq_pow_of_mul_eq_pow_of_coprime exists_eq_pow_of_mul_eq_pow_of_coprime

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (i j «expr ∈ » s) -/
theorem Finset.exists_eq_pow_of_mul_eq_pow_of_coprime {ι R : Type _} [CommSemiring R] [IsDomain R]
    [GCDMonoid R] [Unique Rˣ] {n : ℕ} {c : R} {s : Finset ι} {f : ι → R}
    (h : ∀ (i) (_ : i ∈ s) (j) (_ : j ∈ s), i ≠ j → IsCoprime (f i) (f j))
    (hprod : (∏ i in s, f i) = c ^ n) : ∀ i ∈ s, ∃ d : R, f i = d ^ n := by
  classical
    intro i hi
    rw [← insert_erase hi, prod_insert (not_mem_erase i s)] at hprod
    refine'
      exists_eq_pow_of_mul_eq_pow_of_coprime
        (IsCoprime.prod_right fun j hj => h i hi j (erase_subset i s hj) fun hij => _) hprod
    rw [hij] at hj
    exact (s.not_mem_erase _) hj
#align finset.exists_eq_pow_of_mul_eq_pow_of_coprime Finset.exists_eq_pow_of_mul_eq_pow_of_coprime

end CancelMonoidWithZero

variable {R : Type _} {G : Type _}

section Ring

variable [Ring R] [IsDomain R] [Fintype R]

/-- Every finite domain is a division ring.

TODO: Prove Wedderburn's little theorem,
which shows a finite domain is in fact commutative, hence a field. -/
def Fintype.divisionRingOfIsDomain (R : Type _) [Ring R] [IsDomain R] [DecidableEq R] [Fintype R] :
    DivisionRing R :=
  { show GroupWithZero R from Fintype.groupWithZeroOfCancel R, ‹Ring R› with }
#align fintype.division_ring_of_is_domain Fintype.divisionRingOfIsDomain

/-- Every finite commutative domain is a field.

TODO: Prove Wedderburn's little theorem, which shows a finite domain is automatically commutative,
dropping one assumption from this theorem. -/
def Fintype.fieldOfDomain (R) [CommRing R] [IsDomain R] [DecidableEq R] [Fintype R] : Field R :=
  { Fintype.groupWithZeroOfCancel R, ‹CommRing R› with }
#align fintype.field_of_domain Fintype.fieldOfDomain

theorem Finite.isField_of_domain (R) [CommRing R] [IsDomain R] [Finite R] : IsField R :=
  by
  cases nonempty_fintype R
  exact @Field.toIsField R (@Fintype.fieldOfDomain R _ _ (Classical.decEq R) _)
#align finite.is_field_of_domain Finite.isField_of_domain

end Ring

variable [CommRing R] [IsDomain R] [Group G]

theorem card_nthRoots_subgroup_units [Fintype G] (f : G →* R) (hf : Injective f) {n : ℕ}
    (hn : 0 < n) (g₀ : G) :
    ({ g ∈ univ | g ^ n = g₀ } : Finset G).card ≤ (nthRoots n (f g₀)).card :=
  by
  haveI : DecidableEq R := Classical.decEq _
  refine' le_trans _ (nth_roots n (f g₀)).toFinset_card_le
  apply card_le_card_of_inj_on f
  · intro g hg
    rw [sep_def, mem_filter] at hg
    rw [Multiset.mem_toFinset, mem_nth_roots hn, ← f.map_pow, hg.2]
  · intros
    apply hf
    assumption
#align card_nth_roots_subgroup_units card_nthRoots_subgroup_units

/-- A finite subgroup of the unit group of an integral domain is cyclic. -/
theorem isCyclic_of_subgroup_isDomain [Finite G] (f : G →* R) (hf : Injective f) : IsCyclic G := by
  classical
    cases nonempty_fintype G
    apply isCyclic_of_card_pow_eq_one_le
    intro n hn
    convert le_trans (card_nthRoots_subgroup_units f hf hn 1) (card_nth_roots n (f 1))
#align is_cyclic_of_subgroup_is_domain isCyclic_of_subgroup_isDomain

/-- The unit group of a finite integral domain is cyclic.

To support `ℤˣ` and other infinite monoids with finite groups of units, this requires only
`finite Rˣ` rather than deducing it from `finite R`. -/
instance [Finite Rˣ] : IsCyclic Rˣ :=
  isCyclic_of_subgroup_isDomain (Units.coeHom R) <| Units.ext

section

variable (S : Subgroup Rˣ) [Finite S]

/-- A finite subgroup of the units of an integral domain is cyclic. -/
instance subgroup_units_cyclic : IsCyclic S :=
  by
  refine' isCyclic_of_subgroup_isDomain ⟨(coe : S → R), _, _⟩ (units.ext.comp Subtype.val_injective)
  · simp
  · intros
    simp
#align subgroup_units_cyclic subgroup_units_cyclic

end

section EuclideanDivision

namespace Polynomial

open Polynomial

variable (K : Type) [Field K] [Algebra R[X] K] [IsFractionRing R[X] K]

theorem div_eq_quo_add_rem_div (f : R[X]) {g : R[X]} (hg : g.Monic) :
    ∃ q r : R[X], r.degree < g.degree ∧ (↑f : K) / ↑g = ↑q + ↑r / ↑g :=
  by
  refine' ⟨f /ₘ g, f %ₘ g, _, _⟩
  · exact degree_mod_by_monic_lt _ hg
  · have hg' : (↑g : K) ≠ 0 := by exact_mod_cast monic.ne_zero hg
    field_simp [hg']
    norm_cast
    rw [add_comm, mul_comm, mod_by_monic_add_div f hg]
#align polynomial.div_eq_quo_add_rem_div Polynomial.div_eq_quo_add_rem_div

end Polynomial

end EuclideanDivision

variable [Fintype G]

theorem card_fiber_eq_of_mem_range {H : Type _} [Group H] [DecidableEq H] (f : G →* H) {x y : H}
    (hx : x ∈ Set.range f) (hy : y ∈ Set.range f) :
    (univ.filterₓ fun g => f g = x).card = (univ.filterₓ fun g => f g = y).card :=
  by
  rcases hx with ⟨x, rfl⟩
  rcases hy with ⟨y, rfl⟩
  refine' card_congr (fun g _ => g * x⁻¹ * y) _ _ fun g hg => ⟨g * y⁻¹ * x, _⟩
  ·
    simp (config := { contextual := true }) only [mem_filter, one_mul, MonoidHom.map_mul, mem_univ,
      mul_right_inv, eq_self_iff_true, MonoidHom.map_mul_inv, and_self_iff, forall_true_iff]
  · simp only [mul_left_inj, imp_self, forall₂_true_iff]
  · simp only [true_and_iff, mem_filter, mem_univ] at hg
    simp only [hg, mem_filter, one_mul, MonoidHom.map_mul, mem_univ, mul_right_inv,
      eq_self_iff_true, exists_prop_of_true, MonoidHom.map_mul_inv, and_self_iff,
      mul_inv_cancel_right, inv_mul_cancel_right]
#align card_fiber_eq_of_mem_range card_fiber_eq_of_mem_range

/-- In an integral domain, a sum indexed by a nontrivial homomorphism from a finite group is zero.
-/
theorem sum_hom_units_eq_zero (f : G →* R) (hf : f ≠ 1) : (∑ g : G, f g) = 0 := by
  classical
    obtain ⟨x, hx⟩ :
      ∃ x : MonoidHom.range f.to_hom_units,
        ∀ y : MonoidHom.range f.to_hom_units, y ∈ Submonoid.powers x
    exact IsCyclic.exists_monoid_generator
    have hx1 : x ≠ 1 := by
      rintro rfl
      apply hf
      ext g
      rw [MonoidHom.one_apply]
      cases' hx ⟨f.to_hom_units g, g, rfl⟩ with n hn
      rwa [Subtype.ext_iff, Units.ext_iff, Subtype.coe_mk, MonoidHom.coe_toHomUnits, one_pow,
        eq_comm] at hn
    replace hx1 : (x : R) - 1 ≠ 0
    exact fun h => hx1 (Subtype.eq (Units.ext (sub_eq_zero.1 h)))
    let c := (univ.filter fun g => f.to_hom_units g = 1).card
    calc
      (∑ g : G, f g) = ∑ g : G, f.to_hom_units g := rfl
      _ =
          ∑ u : Rˣ in univ.image f.to_hom_units,
            (univ.filter fun g => f.to_hom_units g = u).card • u :=
        (sum_comp (coe : Rˣ → R) f.to_hom_units)
      _ = ∑ u : Rˣ in univ.image f.to_hom_units, c • u :=
        (sum_congr rfl fun u hu => congr_arg₂ _ _ rfl)
      -- remaining goal 1, proven below
          _ =
          ∑ b : MonoidHom.range f.to_hom_units, c • ↑b :=
        (Finset.sum_subtype _ (by simp) _)
      _ = c • ∑ b : MonoidHom.range f.to_hom_units, (b : R) := smul_sum.symm
      _ = c • 0 := (congr_arg₂ _ rfl _)
      -- remaining goal 2, proven below
          _ =
          0 :=
        smul_zero _

    · -- remaining goal 1
      show (univ.filter fun g : G => f.to_hom_units g = u).card = c
      apply card_fiber_eq_of_mem_range f.to_hom_units
      · simpa only [mem_image, mem_univ, exists_prop_of_true, Set.mem_range] using hu
      · exact ⟨1, f.to_hom_units.map_one⟩
    -- remaining goal 2
    show (∑ b : MonoidHom.range f.to_hom_units, (b : R)) = 0
    calc
      (∑ b : MonoidHom.range f.to_hom_units, (b : R)) = ∑ n in range (orderOf x), x ^ n :=
        Eq.symm <|
          sum_bij (fun n _ => x ^ n) (by simp only [mem_univ, forall_true_iff])
            (by
              simp only [imp_true_iff, eq_self_iff_true, Subgroup.coe_pow, Units.val_pow_eq_pow_val,
                coe_coe])
            (fun m n hm hn =>
              pow_injective_of_lt_orderOf _ (by simpa only [mem_range] using hm)
                (by simpa only [mem_range] using hn))
            fun b hb =>
            let ⟨n, hn⟩ := hx b
            ⟨n % orderOf x, mem_range.2 (Nat.mod_lt _ (orderOf_pos _)), by
              rw [← pow_eq_mod_orderOf, hn]⟩
      _ = 0 := _

    rw [← mul_left_inj' hx1, MulZeroClass.zero_mul, geom_sum_mul, coe_coe]
    norm_cast
    simp [pow_orderOf_eq_one]
#align sum_hom_units_eq_zero sum_hom_units_eq_zero

/-- In an integral domain, a sum indexed by a homomorphism from a finite group is zero,
unless the homomorphism is trivial, in which case the sum is equal to the cardinality of the group.
-/
theorem sum_hom_units (f : G →* R) [Decidable (f = 1)] :
    (∑ g : G, f g) = if f = 1 then Fintype.card G else 0 :=
  by
  split_ifs with h h
  · simp [h, card_univ]
  · exact sum_hom_units_eq_zero f h
#align sum_hom_units sum_hom_units

end


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.deprecated.subring
import Mathlib.algebra.group_with_zero.power
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

class is_subfield {F : Type u_1} [field F] (S : set F)
extends is_subring S
where
  inv_mem : ∀ {x : F}, x ∈ S → x⁻¹ ∈ S

protected instance is_subfield.field {F : Type u_1} [field F] (S : set F) [is_subfield S] : field ↥S :=
  let cr_inst : comm_ring ↥S := subset.comm_ring;
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul sorry
    comm_ring.one sorry sorry sorry sorry sorry (fun (x : ↥S) => { val := ↑x⁻¹, property := sorry }) sorry sorry sorry

theorem is_subfield.pow_mem {F : Type u_1} [field F] {a : F} {n : ℤ} {s : set F} [is_subfield s] (h : a ∈ s) : a ^ n ∈ s :=
  int.cases_on n (fun (n : ℕ) => is_submonoid.pow_mem h) fun (n : ℕ) => is_subfield.inv_mem (is_submonoid.pow_mem h)

protected instance univ.is_subfield {F : Type u_1} [field F] : is_subfield set.univ :=
  is_subfield.mk fun (x : F) (ᾰ : x ∈ set.univ) => trivial

/- note: in the next two declarations, if we let type-class inference figure out the instance
  `ring_hom.is_subring_preimage` then that instance only applies when particular instances of
  `is_add_subgroup _` and `is_submonoid _` are chosen (which are not the default ones).
  If we specify it explicitly, then it doesn't complain. -/

protected instance preimage.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K] (f : F →+* K) (s : set K) [is_subfield s] : is_subfield (⇑f ⁻¹' s) :=
  is_subfield.mk
    fun (a : F) (ha : coe_fn f a ∈ s) =>
      (fun (this : coe_fn f (a⁻¹) ∈ s) => this)
        (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f (a⁻¹) ∈ s)) (ring_hom.map_inv f a))) (is_subfield.inv_mem ha))

protected instance image.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K] (f : F →+* K) (s : set F) [is_subfield s] : is_subfield (⇑f '' s) :=
  is_subfield.mk fun (a : K) (_x : a ∈ ⇑f '' s) => sorry

protected instance range.is_subfield {F : Type u_1} [field F] {K : Type u_2} [field K] (f : F →+* K) : is_subfield (set.range ⇑f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_subfield (set.range ⇑f))) (Eq.symm set.image_univ))) (image.is_subfield f set.univ)

namespace field

/-- `field.closure s` is the minimal subfield that includes `s`. -/
def closure {F : Type u_1} [field F] (S : set F) : set F :=
  set_of fun (x : F) => ∃ (y : F), ∃ (H : y ∈ ring.closure S), ∃ (z : F), ∃ (H : z ∈ ring.closure S), y / z = x

theorem ring_closure_subset {F : Type u_1} [field F] {S : set F} : ring.closure S ⊆ closure S :=
  fun (x : F) (hx : x ∈ ring.closure S) =>
    Exists.intro x (Exists.intro hx (Exists.intro 1 (Exists.intro is_submonoid.one_mem (div_one x))))

protected instance closure.is_submonoid {F : Type u_1} [field F] {S : set F} : is_submonoid (closure S) := sorry

protected instance closure.is_subfield {F : Type u_1} [field F] {S : set F} : is_subfield (closure S) := sorry

theorem mem_closure {F : Type u_1} [field F] {S : set F} {a : F} (ha : a ∈ S) : a ∈ closure S :=
  ring_closure_subset (ring.mem_closure ha)

theorem subset_closure {F : Type u_1} [field F] {S : set F} : S ⊆ closure S :=
  fun (_x : F) => mem_closure

theorem closure_subset {F : Type u_1} [field F] {S : set F} {T : set F} [is_subfield T] (H : S ⊆ T) : closure S ⊆ T := sorry

theorem closure_subset_iff {F : Type u_1} [field F] (s : set F) (t : set F) [is_subfield t] : closure s ⊆ t ↔ s ⊆ t :=
  { mp := set.subset.trans subset_closure, mpr := closure_subset }

theorem closure_mono {F : Type u_1} [field F] {s : set F} {t : set F} (H : s ⊆ t) : closure s ⊆ closure t :=
  closure_subset (set.subset.trans H subset_closure)

end field

theorem is_subfield_Union_of_directed {F : Type u_1} [field F] {ι : Type u_2} [hι : Nonempty ι] (s : ι → set F) [∀ (i : ι), is_subfield (s i)] (directed : ∀ (i j : ι), ∃ (k : ι), s i ⊆ s k ∧ s j ⊆ s k) : is_subfield (set.Union fun (i : ι) => s i) := sorry

protected instance is_subfield.inter {F : Type u_1} [field F] (S₁ : set F) (S₂ : set F) [is_subfield S₁] [is_subfield S₂] : is_subfield (S₁ ∩ S₂) :=
  is_subfield.mk
    fun (x : F) (hx : x ∈ S₁ ∩ S₂) =>
      { left := is_subfield.inv_mem (and.left hx), right := is_subfield.inv_mem (and.right hx) }

protected instance is_subfield.Inter {F : Type u_1} [field F] {ι : Sort u_2} (S : ι → set F) [h : ∀ (y : ι), is_subfield (S y)] : is_subfield (set.Inter S) :=
  is_subfield.mk
    fun (x : F) (hx : x ∈ set.Inter S) =>
      iff.mpr set.mem_Inter fun (y : ι) => is_subfield.inv_mem (iff.mp set.mem_Inter hx y)


theorem n_minus_one_le_n {n : Nat} : n > 0 → n - 1 < n := by
  cases n with
  | zero => simp []
  | succ n =>
  intros
  rw [Nat.succ_eq_add_one, Nat.add_sub_cancel]
  apply Nat.le.refl

partial def foo : Array Int → Int
  | arr => Id.run do
    let mut r : Int := 1
    while h : arr.size > 0 do
      r := r * arr[arr.size - 1]'(by apply n_minus_one_le_n h)
    return r