/-
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.continuous_on
import topology.constructions

/-!
# Bases of topologies. Countability axioms.

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.
* `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 classical
open_locale topological_space 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)

/-- If a family of sets `s` generates the topology, then nonempty 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 α) | finite f ∧ f ⊆ s ∧ (⋂₀ f).nonempty}) :=
begin
  refine ⟨_, _, _⟩,
  { rintro _ ⟨t₁, ⟨hft₁, ht₁b, ht₁⟩, rfl⟩ _ ⟨t₂, ⟨hft₂, ht₂b, ht₂⟩, rfl⟩ x h,
    have : ⋂₀ (t₁ ∪ t₂) = ⋂₀ t₁ ∩ ⋂₀ t₂ := sInter_union t₁ t₂,
    exact ⟨_, ⟨t₁ ∪ t₂, ⟨hft₁.union hft₂, union_subset ht₁b ht₂b, this.symm ▸ ⟨x, h⟩⟩, this⟩, h,
      subset.rfl⟩ },
  { rw [sUnion_image, bUnion_eq_univ_iff],
    intro x, have : x ∈ ⋂₀ ∅, { rw sInter_empty, exact mem_univ x },
    exact ⟨∅, ⟨finite_empty, empty_subset _, x, this⟩, this⟩ },
  { rw hs,
    apply le_antisymm; apply le_generate_from,
    { rintro _ ⟨t, ⟨hft, htb, ht⟩, rfl⟩,
      exact @is_open_sInter _ (generate_from s) _ hft (λ s hs, generate_open.basic _ $ htb hs) },
    { intros t ht,
      rcases t.eq_empty_or_nonempty with rfl|hne, { apply @is_open_empty _ _ },
      rw ← sInter_singleton t at hne ⊢,
      exact generate_open.basic _ ⟨{t}, ⟨finite_singleton t, singleton_subset_iff.2 ht, hne⟩,
        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 binfi_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 only [mem_bUnion_iff, exists_prop, mem_set_of_eq, and_assoc, and.left_comm], refl },
  { 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.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_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 set.prod 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.prod 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 α, countable s ∧ dense s)

lemma exists_countable_dense [separable_space α] :
  ∃ s : set α, countable s ∧ 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 countable_iff_exists_surjective.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 {α}

/-- 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) :
  countable a :=
begin
  rcases eq_empty_or_nonempty a with rfl|H, { exact countable_empty },
  haveI : inhabited α,
  { choose i ia using H,
    choose y hy using h'a i ia,
    exact ⟨y⟩ },
  rcases exists_countable_dense α with ⟨u, u_count, u_dense⟩,
  have : ∀ i, i ∈ a → ∃ y, y ∈ s i ∩ u :=
    λ i hi, dense_iff_inter_open.1 u_dense (s i) (ha i hi) (h'a i hi),
  choose! f hf using this,
  have f_inj : inj_on f a,
  { assume i hi j hj hij,
    have : ¬disjoint (s i) (s j),
    { rw not_disjoint_iff_nonempty_inter,
      refine ⟨f i, (hf i hi).1, _⟩,
      rw hij,
      exact (hf j hj).1 },
    contrapose! this,
    exact h i hi j hj this },
  apply countable_of_injective_of_countable_image f_inj,
  apply u_count.mono _,
  exact image_subset_iff.2 (λ i hi, (hf i hi).2)
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) :
  countable a :=
(h.mono $ λ i, interior_subset).countable_of_is_open (λ i hi, is_open_interior) ha

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

/-- 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, countable t ∧ 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, countable t ∧ 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_subtype_mk _ continuous_id)

/-- 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 α, countable s ∧ 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 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 α), countable b ∧ t = topological_space.generate_from b)

variable {α}

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

variable (α)

lemma exists_countable_basis [second_countable_topology α] :
  ∃b:set (set α), countable b ∧ ∅ ∉ b ∧ is_topological_basis b :=
let ⟨b, hb₁, hb₂⟩ := second_countable_topology.is_open_generated_countable α in
let b' := (λs, ⋂₀ s) '' {s:set (set α) | finite s ∧ s ⊆ b ∧ (⋂₀ s).nonempty} in
⟨b',
  ((countable_set_of_finite_subset hb₁).mono
    (by { simp only [← and_assoc], apply inter_subset_left })).image _,
  assume ⟨s, ⟨_, _, hn⟩, hp⟩, absurd hn (not_nonempty_iff_eq_empty.2 hp),
  is_topological_basis_of_subbasis hb₂⟩

/-- 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 (countable_basis α) :=
(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 :=
ne_empty_iff_nonempty.1 $ 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 second_countable_topology_encodable {ι : Type*} {π : ι → Type*}
  [encodable ι] [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 : 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 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

instance second_countable_topology_fintype {ι : Type*} {π : ι → Type*}
  [fintype ι] [t : ∀a, topological_space (π a)] [∀a, second_countable_topology (π a)] :
  second_countable_topology (∀a, π a) :=
by { letI := fintype.encodable ι, exact topological_space.second_countable_topology_encodable }

@[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 ι, countable T ∧ (⋃ 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,
    subset.antisymm (bUnion_subset_Union _ _) (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 α), countable T ∧ 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 α, countable s ∧ (⋃ 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 (bUnion_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, countable t ∧ 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

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) 2016 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu
-/

import tools.super
open classical nat function prod subtype super

noncomputable theory

theorem lt_or_eq_of_lt_succ {n m : ℕ} (H : n < succ m) : n < m ∨ n = m :=
lt_or_eq_of_le (le_of_lt_succ H)

theorem and_of_not_imp {p q : Prop} (H : ¬ (p → ¬ q)) : p ∧ q := by super

theorem not_not_elim {a : Prop} : ¬¬a → a := by_contradiction

theorem exists_not_of_not_forall {A : Type} {p : A → Prop} (H : ¬∀x, p x) : ∃x, ¬p x :=
by_contradiction (λ neg, have ∀ x, ¬ ¬ p x, from forall_not_of_not_exists neg,
show _, from H (λ x, not_not_elim (this x)))

theorem existence_of_nat_gt (n : ℕ) : ∃ m, n < m := ⟨(succ n),(lt_succ_self n)⟩

namespace kruskal

structure [class] quasiorder (A : Type) extends has_le A :=
(refl : ∀ a, le a a)
(trans : ∀ {a b c}, le a b → le b c → le a c)

structure [class] wqo  (A : Type) extends quasiorder A :=
(is_good : ∀ f : ℕ → A,  ∃ i j, i < j ∧ le (f i) (f j))

def is_good {A : Type} (f : ℕ → A) (o : A → A → Prop) := ∃ i j : ℕ, i < j ∧ o (f i) (f j)

def prod_order {A B : Type} (o₁ : A → A → Prop) (o₂ : B → B → Prop) (s : A × B) (t : A × B) :=
o₁ (s.1) (t.1) ∧ o₂ (s.2) (t.2)

instance qo_prod  {A B: Type} [o₁ : quasiorder A] [o₂ : quasiorder B] : quasiorder (A × B) :=
let op : A × B → A × B → Prop  := prod_order o₁.le o₂.le in
have refl : ∀ p : A × B, op p p, by intro; apply and.intro; repeat {apply quasiorder.refl},
have trans : ∀ a b c, op a b → op b c → op a c, from λ x y z h1 h2,
⟨(quasiorder.trans h1^.left h2^.left), quasiorder.trans h1^.right h2^.right⟩,
show _, from quasiorder.mk (has_le.mk op) refl trans

def terminal {A : Type} (o : A → A → Prop) (f : ℕ → A) (m : ℕ) :=
∀ n, m < n → ¬ o (f m) (f n)

theorem lt_of_non_terminal {A : Type} {o : A → A → Prop} {f : ℕ → A} {m : ℕ} (H : ¬ @terminal _ o f m) :
  ∃ n, m < n ∧ o (f m) (f n) :=
let ⟨n,h⟩ := exists_not_of_not_forall H in ⟨n,(and_of_not_imp h)⟩

section
parameter {A : Type}
parameter [o : wqo A]
parameter f : ℕ → A

  section
  parameter H : ∀ N, ∃ r, N < r ∧ terminal o.le f r

  def terminal_index (n : ℕ) : {x : ℕ // n < x ∧ terminal o.le f x} :=
  nat.rec_on n (let i := some (H 0) in ⟨i, (some_spec (H 0))⟩)
  (λ a rec_call,
   let i' := rec_call.1, i := some (H i') in
   have p : i' < i ∧ terminal o.le f i, from some_spec (H i'),
   have a < i', from (rec_call.2)^.left,
   have succ a < i, from lt_of_le_of_lt this p^.left,
   ⟨i, ⟨this,p^.right⟩⟩)

  lemma increasing_ti {n m : ℕ} : n < m → (terminal_index n).1 < (terminal_index m).1 :=
  nat.rec_on m (λ H, absurd H dec_trivial)
  (λ a ih lt,
   have disj : n < a ∨ n = a, from lt_or_eq_of_lt_succ lt,
   have (terminal_index a).1 < (terminal_index (succ a)).1, from
     (some_spec $ H (terminal_index a).1)^.left,
   or.elim disj (λ Hl, lt_trans (ih Hl) this) (λ Hr, by rw Hr;exact this))

  private def g (n : ℕ) := f (terminal_index n).1

  lemma terminal_g (n : ℕ) : terminal o.le g n :=
  have ∀ n', (terminal_index n).1 < n' → ¬ (f (terminal_index n)^.1) ≤ (f n'), from ((terminal_index n).2)^.right,
  λ n' h, this (terminal_index n').1 (increasing_ti h)

  lemma bad_g : ¬ is_good g o.le :=
  have H1 : ∀ i j, i < j → ¬ (g i) ≤ (g j), from λ i j h, (terminal_g i) j h,
  suppose ∃ i j, i < j ∧  (g i) ≤ (g j),
  let ⟨i,j,h⟩ := this in
  have ¬ (g i) ≤ (g j), from H1 i j h^.left,
  show _, from this h^.right

  lemma local_contradiction : false := bad_g (wqo.is_good g)

  end

theorem finite_terminal : ∃ N, ∀ r, N < r → ¬ terminal o.le f r :=
have ¬ ∀ N, ∃ r, N < r ∧ @terminal A o.le f r, by apply local_contradiction,
have ∃ N, ¬ ∃ r, N < r ∧ @terminal A o.le f r, by super,
let ⟨n,h⟩ := this in
have ∀ r, n < r → ¬ @terminal A o.le f r, by super,
⟨n,this⟩

end

section

parameters {A B : Type}
parameters [o₁ : wqo A] [o₂ : wqo B]

  section

  parameter f : ℕ → A × B

  theorem  finite_terminal_on_A : ∃ N, ∀ r, N < r → ¬ @terminal A o₁.le (fst ∘ f) r :=
  finite_terminal (fst ∘ f)

  def sentinel := some finite_terminal_on_A

  def h_helper (n : ℕ) : {x : ℕ // sentinel < x ∧ ¬ @terminal A o₁.le (fst ∘ f) x} :=
  nat.rec_on n
  (have ∃ m, sentinel < m, by apply existence_of_nat_gt,
  let i := some this in have ge : sentinel < i, from some_spec this,
  have ¬ @terminal A o₁.le (fst ∘ f) i, from (some_spec finite_terminal_on_A) i ge,
  have sentinel < i ∧ ¬ terminal o₁.le (fst ∘ f) i, from ⟨ge,this⟩,
  ⟨i, this⟩)
  (λ a rec_call, let i' := rec_call.1 in
  have lt' : sentinel < i', from (rec_call.2)^.left,
  have ¬ terminal o₁.le (fst ∘ f) i', from (rec_call.2)^.right,
  have ∃ n, i' < n ∧ ((fst ∘ f) i') ≤ ((fst ∘ f) n), from lt_of_non_terminal this,
  let i := some this in have i' < i, from (some_spec this)^.left,
  have lt : sentinel < i, from lt.trans lt' this,
  have ∀ r, sentinel < r → ¬ terminal o₁.le (fst ∘ f) r, from some_spec finite_terminal_on_A,
  have ¬ terminal o₁.le (fst ∘ f) i, from this i lt,
  have sentinel < i ∧ ¬ terminal o₁.le (fst ∘ f) i, from ⟨lt,this⟩,
  ⟨i,this⟩)

  private def h (n : ℕ) : ℕ := (h_helper n).1

  private lemma foo (a : ℕ) : h a < h (succ a) ∧ (fst ∘ f) (h a) ≤ (fst ∘ f) (h (succ a)) :=
  have ¬ terminal o₁.le (fst ∘ f) (h a), from ((h_helper a).2)^.right,
  have ∃ n, (h a) < n ∧ ((fst ∘ f) (h a)) ≤ ((fst ∘ f) n), from lt_of_non_terminal this,
  show _, from some_spec this

  theorem property_of_h {i j : ℕ} : i < j → (fst ∘ f) (h i) ≤ (fst ∘ f) (h j) :=
  nat.rec_on j (λ H, absurd H dec_trivial)
  (λ a IH lt,
  have H1 : (fst ∘ f) (h a) ≤ (fst ∘ f) (h (succ a)), from (foo a)^.right,
  have disj : i < a ∨ i = a, from lt_or_eq_of_lt_succ lt,
  or.elim disj (λ Hl, quasiorder.trans (IH Hl) H1) (λ Hr, by simp [Hr, H1]))

  theorem increasing_h {i j : ℕ} : i < j → h i < h j :=
  nat.rec_on j
  (λ H, absurd H dec_trivial)
  (λ a ih lt,
  have H1 : (h a) < h (succ a), from (foo a)^.left,
  have disj : i < a ∨ i = a, from lt_or_eq_of_lt_succ lt,
  or.elim disj (λ Hl, lt_trans (ih Hl) H1) (λ Hr, by simp [Hr, H1]))

  theorem good_f : is_good f (prod_order o₁.le o₂.le) :=
  have ∃ i j : ℕ, i < j ∧ (snd ∘ f ∘ h) i ≤ (snd ∘ f ∘ h) j, from wqo.is_good (snd ∘ f ∘ h),
  let ⟨i,j,H⟩ := this in
  have (fst ∘ f) (h i) ≤ (fst ∘ f) (h j), from property_of_h H^.left,
  have Hr : (fst ∘ f) (h i) ≤ (fst ∘ f) (h j) ∧ (snd ∘ f) (h i) ≤ (snd ∘ f) (h j), from ⟨this, H^.right⟩,
  have h i < h j, from increasing_h H^.left,
  ⟨(h i), (h j), ⟨this,Hr⟩⟩

  end

theorem good_pairs (f : ℕ → A × B) : is_good f (prod_order o₁.le o₂.le) := good_f f

end

def wqo_prod {A B : Type} [o₁ : wqo A] [o₂ : wqo B] : wqo (A × B) :=
let op : A × B → A × B → Prop := prod_order o₁.le o₂.le in
have refl : ∀ p : A × B, op p p, from λ p, ⟨quasiorder.refl p.1,quasiorder.refl p.2⟩, -- by intro; apply and.intro;repeat {apply wqo.refl},
have trans : ∀ a b c, op a b → op b c → op a c, from λ a b c h1 h2,
  ⟨quasiorder.trans h1^.left h2^.left, quasiorder.trans h1^.right h2^.right⟩,
show _, from wqo.mk ⟨⟨op⟩,refl,trans⟩ good_pairs

-- example {A B : Type} [o₁ : wqo A] [o₂ : wqo B] : (@wqo_prod A B _ _).le = prod_order o₁.le o₂.le := rfl

end kruskal


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro, Neil Strickland
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.prime
import Mathlib.data.pnat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Primality and GCD on pnat

This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, analogous to those on
`nat`.
-/

namespace nat.primes

protected instance coe_pnat : has_coe primes ℕ+ :=
  has_coe.mk fun (p : primes) => { val := ↑p, property := sorry }

theorem coe_pnat_nat (p : primes) : ↑↑p = ↑p :=
  rfl

theorem coe_pnat_inj (p : primes) (q : primes) : ↑p = ↑q → p = q := sorry

end nat.primes

namespace pnat

/-- The greatest common divisor (gcd) of two positive natural numbers,
  viewed as positive natural number. -/
def gcd (n : ℕ+) (m : ℕ+) : ℕ+ :=
  { val := nat.gcd ↑n ↑m, property := sorry }

/-- The least common multiple (lcm) of two positive natural numbers,
  viewed as positive natural number. -/
def lcm (n : ℕ+) (m : ℕ+) : ℕ+ :=
  { val := nat.lcm ↑n ↑m, property := sorry }

@[simp] theorem gcd_coe (n : ℕ+) (m : ℕ+) : ↑(gcd n m) = nat.gcd ↑n ↑m :=
  rfl

@[simp] theorem lcm_coe (n : ℕ+) (m : ℕ+) : ↑(lcm n m) = nat.lcm ↑n ↑m :=
  rfl

theorem gcd_dvd_left (n : ℕ+) (m : ℕ+) : gcd n m ∣ n :=
  iff.mpr dvd_iff (nat.gcd_dvd_left ↑n ↑m)

theorem gcd_dvd_right (n : ℕ+) (m : ℕ+) : gcd n m ∣ m :=
  iff.mpr dvd_iff (nat.gcd_dvd_right ↑n ↑m)

theorem dvd_gcd {m : ℕ+} {n : ℕ+} {k : ℕ+} (hm : k ∣ m) (hn : k ∣ n) : k ∣ gcd m n :=
  iff.mpr dvd_iff (nat.dvd_gcd (iff.mp dvd_iff hm) (iff.mp dvd_iff hn))

theorem dvd_lcm_left (n : ℕ+) (m : ℕ+) : n ∣ lcm n m :=
  iff.mpr dvd_iff (nat.dvd_lcm_left ↑n ↑m)

theorem dvd_lcm_right (n : ℕ+) (m : ℕ+) : m ∣ lcm n m :=
  iff.mpr dvd_iff (nat.dvd_lcm_right ↑n ↑m)

theorem lcm_dvd {m : ℕ+} {n : ℕ+} {k : ℕ+} (hm : m ∣ k) (hn : n ∣ k) : lcm m n ∣ k :=
  iff.mpr dvd_iff (nat.lcm_dvd (iff.mp dvd_iff hm) (iff.mp dvd_iff hn))

theorem gcd_mul_lcm (n : ℕ+) (m : ℕ+) : gcd n m * lcm n m = n * m :=
  subtype.eq (nat.gcd_mul_lcm ↑n ↑m)

theorem eq_one_of_lt_two {n : ℕ+} : n < bit0 1 → n = 1 :=
  fun (h : n < bit0 1) =>
    le_antisymm (id (fun (h : n < 1 + 1) => eq.mp (Eq._oldrec (Eq.refl (n < 1 + 1)) (propext lt_add_one_iff)) h) h)
      (one_le n)

/-! ### Prime numbers -/

/-- Primality predicate for `ℕ+`, defined in terms of `nat.prime`. -/
def prime (p : ℕ+) :=
  nat.prime ↑p

theorem prime.one_lt {p : ℕ+} : prime p → 1 < p :=
  nat.prime.one_lt

theorem prime_two : prime (bit0 1) :=
  nat.prime_two

theorem dvd_prime {p : ℕ+} {m : ℕ+} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p := sorry

theorem prime.ne_one {p : ℕ+} : prime p → p ≠ 1 := sorry

@[simp] theorem not_prime_one : ¬prime 1 :=
  nat.not_prime_one

theorem prime.not_dvd_one {p : ℕ+} : prime p → ¬p ∣ 1 :=
  fun (pp : prime p) => eq.mpr (id (Eq._oldrec (Eq.refl (¬p ∣ 1)) (propext dvd_iff))) (nat.prime.not_dvd_one pp)

theorem exists_prime_and_dvd {n : ℕ+} : bit0 1 ≤ n → ∃ (p : ℕ+), prime p ∧ p ∣ n := sorry

/-! ### Coprime numbers and gcd -/

/-- Two pnats are coprime if their gcd is 1. -/
def coprime (m : ℕ+) (n : ℕ+) :=
  gcd m n = 1

@[simp] theorem coprime_coe {m : ℕ+} {n : ℕ+} : nat.coprime ↑m ↑n ↔ coprime m n := sorry

theorem coprime.mul {k : ℕ+} {m : ℕ+} {n : ℕ+} : coprime m k → coprime n k → coprime (m * n) k := sorry

theorem coprime.mul_right {k : ℕ+} {m : ℕ+} {n : ℕ+} : coprime k m → coprime k n → coprime k (m * n) := sorry

theorem gcd_comm {m : ℕ+} {n : ℕ+} : gcd m n = gcd n m := sorry

theorem gcd_eq_left_iff_dvd {m : ℕ+} {n : ℕ+} : m ∣ n ↔ gcd m n = m := sorry

theorem gcd_eq_right_iff_dvd {m : ℕ+} {n : ℕ+} : m ∣ n ↔ gcd n m = m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ∣ n ↔ gcd n m = m)) gcd_comm)) gcd_eq_left_iff_dvd

theorem coprime.gcd_mul_left_cancel (m : ℕ+) {n : ℕ+} {k : ℕ+} : coprime k n → gcd (k * m) n = gcd m n := sorry

theorem coprime.gcd_mul_right_cancel (m : ℕ+) {n : ℕ+} {k : ℕ+} : coprime k n → gcd (m * k) n = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime k n → gcd (m * k) n = gcd m n)) (mul_comm m k)))
    (coprime.gcd_mul_left_cancel m)

theorem coprime.gcd_mul_left_cancel_right (m : ℕ+) {n : ℕ+} {k : ℕ+} : coprime k m → gcd m (k * n) = gcd m n := sorry

theorem coprime.gcd_mul_right_cancel_right (m : ℕ+) {n : ℕ+} {k : ℕ+} : coprime k m → gcd m (n * k) = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime k m → gcd m (n * k) = gcd m n)) (mul_comm n k)))
    (coprime.gcd_mul_left_cancel_right m)

@[simp] theorem one_gcd {n : ℕ+} : gcd 1 n = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd 1 n = 1)) (Eq.symm (propext gcd_eq_left_iff_dvd)))) (one_dvd n)

@[simp] theorem gcd_one {n : ℕ+} : gcd n 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd n 1 = 1)) gcd_comm)) one_gcd

theorem coprime.symm {m : ℕ+} {n : ℕ+} : coprime m n → coprime n m :=
  eq.mpr (id (imp_congr_eq (coprime.equations._eqn_1 m n) (coprime.equations._eqn_1 n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd m n = 1 → gcd n m = 1)) gcd_comm)) (eq.mpr (id (propext imp_self)) trivial))

@[simp] theorem one_coprime {n : ℕ+} : coprime 1 n :=
  one_gcd

@[simp] theorem coprime_one {n : ℕ+} : coprime n 1 :=
  coprime.symm one_coprime

theorem coprime.coprime_dvd_left {m : ℕ+} {k : ℕ+} {n : ℕ+} : m ∣ k → coprime k n → coprime m n := sorry

theorem coprime.factor_eq_gcd_left {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n) (am : a ∣ m) (bn : b ∣ n) : a = gcd (a * b) m := sorry

theorem coprime.factor_eq_gcd_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n) (am : a ∣ m) (bn : b ∣ n) : a = gcd (b * a) m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd (b * a) m)) (mul_comm b a))) (coprime.factor_eq_gcd_left cop am bn)

theorem coprime.factor_eq_gcd_left_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n) (am : a ∣ m) (bn : b ∣ n) : a = gcd m (a * b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd m (a * b))) gcd_comm)) (coprime.factor_eq_gcd_left cop am bn)

theorem coprime.factor_eq_gcd_right_right {a : ℕ+} {b : ℕ+} {m : ℕ+} {n : ℕ+} (cop : coprime m n) (am : a ∣ m) (bn : b ∣ n) : a = gcd m (b * a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = gcd m (b * a))) gcd_comm)) (coprime.factor_eq_gcd_right cop am bn)

theorem coprime.gcd_mul (k : ℕ+) {m : ℕ+} {n : ℕ+} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n := sorry

theorem gcd_eq_left {m : ℕ+} {n : ℕ+} : m ∣ n → gcd m n = m := sorry

theorem coprime.pow {m : ℕ+} {n : ℕ+} (k : ℕ) (l : ℕ) (h : coprime m n) : coprime (m ^ k) (n ^ l) := sorry


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module category_theory.essentially_small
! leanprover-community/mathlib commit ef7acf407d265ad4081c8998687e994fa80ba70c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Small.Basic
import Mathbin.CategoryTheory.Category.Ulift
import Mathbin.CategoryTheory.Skeletal

/-!
# Essentially small categories.

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

A category given by `(C : Type u) [category.{v} C]` is `w`-essentially small
if there exists a `small_model C : Type w` equipped with `[small_category (small_model C)]`.

A category is `w`-locally small if every hom type is `w`-small.

The main theorem here is that a category is `w`-essentially small iff
the type `skeleton C` is `w`-small, and `C` is `w`-locally small.
-/

universe w v v' u u'

open CategoryTheory

variable (C : Type u) [Category.{v} C]

namespace CategoryTheory

#print CategoryTheory.EssentiallySmall /-
/-- A category is `essentially_small.{w}` if there exists
an equivalence to some `S : Type w` with `[small_category S]`. -/
class EssentiallySmall (C : Type u) [Category.{v} C] : Prop where
  equiv_smallCategory : ∃ (S : Type w)(_ : SmallCategory S), Nonempty (C ≌ S)
#align category_theory.essentially_small CategoryTheory.EssentiallySmall
-/

/- warning: category_theory.essentially_small.mk' -> CategoryTheory.EssentiallySmall.mk' is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_2 : CategoryTheory.Category.{u2, u3} C] {S : Type.{u1}} [_inst_3 : CategoryTheory.SmallCategory.{u1} S], (CategoryTheory.Equivalence.{u2, u1, u3, u1} C _inst_2 S _inst_3) -> (CategoryTheory.EssentiallySmall.{u1, u2, u3} C _inst_2)
but is expected to have type
  forall {C : Type.{u3}} [_inst_2 : CategoryTheory.Category.{u2, u3} C] {S : Type.{u1}} [_inst_3 : CategoryTheory.SmallCategory.{u1} S], (CategoryTheory.Equivalence.{u2, u1, u3, u1} C S _inst_2 _inst_3) -> (CategoryTheory.EssentiallySmall.{u1, u2, u3} C _inst_2)
Case conversion may be inaccurate. Consider using '#align category_theory.essentially_small.mk' CategoryTheory.EssentiallySmall.mk'ₓ'. -/
/-- Constructor for `essentially_small C` from an explicit small category witness. -/
theorem EssentiallySmall.mk' {C : Type u} [Category.{v} C] {S : Type w} [SmallCategory S]
    (e : C ≌ S) : EssentiallySmall.{w} C :=
  ⟨⟨S, _, ⟨e⟩⟩⟩
#align category_theory.essentially_small.mk' CategoryTheory.EssentiallySmall.mk'

#print CategoryTheory.SmallModel /-
/-- An arbitrarily chosen small model for an essentially small category.
-/
@[nolint has_nonempty_instance]
def SmallModel (C : Type u) [Category.{v} C] [EssentiallySmall.{w} C] : Type w :=
  Classical.choose (@EssentiallySmall.equiv_smallCategory C _ _)
#align category_theory.small_model CategoryTheory.SmallModel
-/

#print CategoryTheory.smallCategorySmallModel /-
noncomputable instance smallCategorySmallModel (C : Type u) [Category.{v} C]
    [EssentiallySmall.{w} C] : SmallCategory (SmallModel C) :=
  Classical.choose (Classical.choose_spec (@EssentiallySmall.equiv_smallCategory C _ _))
#align category_theory.small_category_small_model CategoryTheory.smallCategorySmallModel
-/

/- warning: category_theory.equiv_small_model -> CategoryTheory.equivSmallModel is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u3}) [_inst_2 : CategoryTheory.Category.{u2, u3} C] [_inst_3 : CategoryTheory.EssentiallySmall.{u1, u2, u3} C _inst_2], CategoryTheory.Equivalence.{u2, u1, u3, u1} C _inst_2 (CategoryTheory.SmallModel.{u1, u2, u3} C _inst_2 _inst_3) (CategoryTheory.smallCategorySmallModel.{u1, u2, u3} C _inst_2 _inst_3)
but is expected to have type
  forall (C : Type.{u3}) [_inst_2 : CategoryTheory.Category.{u2, u3} C] [_inst_3 : CategoryTheory.EssentiallySmall.{u1, u2, u3} C _inst_2], CategoryTheory.Equivalence.{u2, u1, u3, u1} C (CategoryTheory.SmallModel.{u1, u2, u3} C _inst_2 _inst_3) _inst_2 (CategoryTheory.smallCategorySmallModel.{u1, u2, u3} C _inst_2 _inst_3)
Case conversion may be inaccurate. Consider using '#align category_theory.equiv_small_model CategoryTheory.equivSmallModelₓ'. -/
/-- The (noncomputable) categorical equivalence between
an essentially small category and its small model.
-/
noncomputable def equivSmallModel (C : Type u) [Category.{v} C] [EssentiallySmall.{w} C] :
    C ≌ SmallModel C :=
  Nonempty.some
    (Classical.choose_spec (Classical.choose_spec (@EssentiallySmall.equiv_smallCategory C _ _)))
#align category_theory.equiv_small_model CategoryTheory.equivSmallModel

/- warning: category_theory.essentially_small_congr -> CategoryTheory.essentiallySmall_congr is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} C] {D : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u3, u5} D], (CategoryTheory.Equivalence.{u2, u3, u4, u5} C _inst_2 D _inst_3) -> (Iff (CategoryTheory.EssentiallySmall.{u1, u2, u4} C _inst_2) (CategoryTheory.EssentiallySmall.{u1, u3, u5} D _inst_3))
but is expected to have type
  forall {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} C] {D : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u3, u5} D], (CategoryTheory.Equivalence.{u2, u3, u4, u5} C D _inst_2 _inst_3) -> (Iff (CategoryTheory.EssentiallySmall.{u1, u2, u4} C _inst_2) (CategoryTheory.EssentiallySmall.{u1, u3, u5} D _inst_3))
Case conversion may be inaccurate. Consider using '#align category_theory.essentially_small_congr CategoryTheory.essentiallySmall_congrₓ'. -/
theorem essentiallySmall_congr {C : Type u} [Category.{v} C] {D : Type u'} [Category.{v'} D]
    (e : C ≌ D) : EssentiallySmall.{w} C ↔ EssentiallySmall.{w} D :=
  by
  fconstructor
  · rintro ⟨S, 𝒮, ⟨f⟩⟩
    skip
    exact essentially_small.mk' (e.symm.trans f)
  · rintro ⟨S, 𝒮, ⟨f⟩⟩
    skip
    exact essentially_small.mk' (e.trans f)
#align category_theory.essentially_small_congr CategoryTheory.essentiallySmall_congr

#print CategoryTheory.Discrete.essentiallySmallOfSmall /-
theorem Discrete.essentiallySmallOfSmall {α : Type u} [Small.{w} α] :
    EssentiallySmall.{w} (Discrete α) :=
  ⟨⟨Discrete (Shrink α), ⟨inferInstance, ⟨Discrete.equivalence (equivShrink _)⟩⟩⟩⟩
#align category_theory.discrete.essentially_small_of_small CategoryTheory.Discrete.essentiallySmallOfSmall
-/

#print CategoryTheory.essentiallySmallSelf /-
theorem essentiallySmallSelf : EssentiallySmall.{max w v u} C :=
  EssentiallySmall.mk' (AsSmall.equiv : C ≌ AsSmall.{w} C)
#align category_theory.essentially_small_self CategoryTheory.essentiallySmallSelf
-/

#print CategoryTheory.LocallySmall /-
/-- A category is `w`-locally small if every hom set is `w`-small.

See `shrink_homs C` for a category instance where every hom set has been replaced by a small model.
-/
class LocallySmall (C : Type u) [Category.{v} C] : Prop where
  hom_small : ∀ X Y : C, Small.{w} (X ⟶ Y) := by infer_instance
#align category_theory.locally_small CategoryTheory.LocallySmall
-/

instance (C : Type u) [Category.{v} C] [LocallySmall.{w} C] (X Y : C) : Small (X ⟶ Y) :=
  LocallySmall.hom_small X Y

/- warning: category_theory.locally_small_congr -> CategoryTheory.locallySmall_congr is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} C] {D : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u3, u5} D], (CategoryTheory.Equivalence.{u2, u3, u4, u5} C _inst_2 D _inst_3) -> (Iff (CategoryTheory.LocallySmall.{u1, u2, u4} C _inst_2) (CategoryTheory.LocallySmall.{u1, u3, u5} D _inst_3))
but is expected to have type
  forall {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} C] {D : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u3, u5} D], (CategoryTheory.Equivalence.{u2, u3, u4, u5} C D _inst_2 _inst_3) -> (Iff (CategoryTheory.LocallySmall.{u1, u2, u4} C _inst_2) (CategoryTheory.LocallySmall.{u1, u3, u5} D _inst_3))
Case conversion may be inaccurate. Consider using '#align category_theory.locally_small_congr CategoryTheory.locallySmall_congrₓ'. -/
theorem locallySmall_congr {C : Type u} [Category.{v} C] {D : Type u'} [Category.{v'} D]
    (e : C ≌ D) : LocallySmall.{w} C ↔ LocallySmall.{w} D :=
  by
  fconstructor
  · rintro ⟨L⟩
    fconstructor
    intro X Y
    specialize L (e.inverse.obj X) (e.inverse.obj Y)
    refine' (small_congr _).mpr L
    exact equiv_of_fully_faithful e.inverse
  · rintro ⟨L⟩
    fconstructor
    intro X Y
    specialize L (e.functor.obj X) (e.functor.obj Y)
    refine' (small_congr _).mpr L
    exact equiv_of_fully_faithful e.functor
#align category_theory.locally_small_congr CategoryTheory.locallySmall_congr

#print CategoryTheory.locallySmall_self /-
instance (priority := 100) locallySmall_self (C : Type u) [Category.{v} C] : LocallySmall.{v} C
    where
#align category_theory.locally_small_self CategoryTheory.locallySmall_self
-/

#print CategoryTheory.locallySmall_of_essentiallySmall /-
instance (priority := 100) locallySmall_of_essentiallySmall (C : Type u) [Category.{v} C]
    [EssentiallySmall.{w} C] : LocallySmall.{w} C :=
  (locallySmall_congr (equivSmallModel C)).mpr (CategoryTheory.locallySmall_self _)
#align category_theory.locally_small_of_essentially_small CategoryTheory.locallySmall_of_essentiallySmall
-/

#print CategoryTheory.ShrinkHoms /-
/-- We define a type alias `shrink_homs C` for `C`. When we have `locally_small.{w} C`,
we'll put a `category.{w}` instance on `shrink_homs C`.
-/
@[nolint has_nonempty_instance]
def ShrinkHoms (C : Type u) :=
  C
#align category_theory.shrink_homs CategoryTheory.ShrinkHoms
-/

namespace ShrinkHoms

section

variable {C' : Type _}

#print CategoryTheory.ShrinkHoms.toShrinkHoms /-
-- a fresh variable with no category instance attached
/-- Help the typechecker by explicitly translating from `C` to `shrink_homs C`. -/
def toShrinkHoms {C' : Type _} (X : C') : ShrinkHoms C' :=
  X
#align category_theory.shrink_homs.to_shrink_homs CategoryTheory.ShrinkHoms.toShrinkHoms
-/

#print CategoryTheory.ShrinkHoms.fromShrinkHoms /-
/-- Help the typechecker by explicitly translating from `shrink_homs C` to `C`. -/
def fromShrinkHoms {C' : Type _} (X : ShrinkHoms C') : C' :=
  X
#align category_theory.shrink_homs.from_shrink_homs CategoryTheory.ShrinkHoms.fromShrinkHoms
-/

#print CategoryTheory.ShrinkHoms.to_from /-
@[simp]
theorem to_from (X : C') : fromShrinkHoms (toShrinkHoms X) = X :=
  rfl
#align category_theory.shrink_homs.to_from CategoryTheory.ShrinkHoms.to_from
-/

#print CategoryTheory.ShrinkHoms.from_to /-
@[simp]
theorem from_to (X : ShrinkHoms C') : toShrinkHoms (fromShrinkHoms X) = X :=
  rfl
#align category_theory.shrink_homs.from_to CategoryTheory.ShrinkHoms.from_to
-/

end

variable (C) [LocallySmall.{w} C]

@[simps]
noncomputable instance : Category.{w} (ShrinkHoms C)
    where
  Hom X Y := Shrink (fromShrinkHoms X ⟶ fromShrinkHoms Y)
  id X := equivShrink _ (𝟙 (fromShrinkHoms X))
  comp X Y Z f g := equivShrink _ ((equivShrink _).symm f ≫ (equivShrink _).symm g)

/- warning: category_theory.shrink_homs.functor -> CategoryTheory.ShrinkHoms.functor is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Functor.{u2, u1, u3, u3} C _inst_1 (CategoryTheory.ShrinkHoms.{u3} C) (CategoryTheory.ShrinkHoms.CategoryTheory.category.{u1, u2, u3} C _inst_1 _inst_2)
but is expected to have type
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Functor.{u2, u1, u3, u3} C _inst_1 (CategoryTheory.ShrinkHoms.{u3} C) (CategoryTheory.ShrinkHoms.instCategoryShrinkHoms.{u1, u2, u3} C _inst_1 _inst_2)
Case conversion may be inaccurate. Consider using '#align category_theory.shrink_homs.functor CategoryTheory.ShrinkHoms.functorₓ'. -/
/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable def functor : C ⥤ ShrinkHoms C
    where
  obj X := toShrinkHoms X
  map X Y f := equivShrink (X ⟶ Y) f
#align category_theory.shrink_homs.functor CategoryTheory.ShrinkHoms.functor

/- warning: category_theory.shrink_homs.inverse -> CategoryTheory.ShrinkHoms.inverse is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Functor.{u1, u2, u3, u3} (CategoryTheory.ShrinkHoms.{u3} C) (CategoryTheory.ShrinkHoms.CategoryTheory.category.{u1, u2, u3} C _inst_1 _inst_2) C _inst_1
but is expected to have type
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Functor.{u1, u2, u3, u3} (CategoryTheory.ShrinkHoms.{u3} C) (CategoryTheory.ShrinkHoms.instCategoryShrinkHoms.{u1, u2, u3} C _inst_1 _inst_2) C _inst_1
Case conversion may be inaccurate. Consider using '#align category_theory.shrink_homs.inverse CategoryTheory.ShrinkHoms.inverseₓ'. -/
/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable def inverse : ShrinkHoms C ⥤ C
    where
  obj X := fromShrinkHoms X
  map X Y f := (equivShrink (fromShrinkHoms X ⟶ fromShrinkHoms Y)).symm f
#align category_theory.shrink_homs.inverse CategoryTheory.ShrinkHoms.inverse

/- warning: category_theory.shrink_homs.equivalence -> CategoryTheory.ShrinkHoms.equivalence is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Equivalence.{u2, u1, u3, u3} C _inst_1 (CategoryTheory.ShrinkHoms.{u3} C) (CategoryTheory.ShrinkHoms.CategoryTheory.category.{u1, u2, u3} C _inst_1 _inst_2)
but is expected to have type
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C] [_inst_2 : CategoryTheory.LocallySmall.{u1, u2, u3} C _inst_1], CategoryTheory.Equivalence.{u2, u1, u3, u3} C (CategoryTheory.ShrinkHoms.{u3} C) _inst_1 (CategoryTheory.ShrinkHoms.instCategoryShrinkHoms.{u1, u2, u3} C _inst_1 _inst_2)
Case conversion may be inaccurate. Consider using '#align category_theory.shrink_homs.equivalence CategoryTheory.ShrinkHoms.equivalenceₓ'. -/
/-- The categorical equivalence between `C` and `shrink_homs C`, when `C` is locally small.
-/
@[simps]
noncomputable def equivalence : C ≌ ShrinkHoms C :=
  Equivalence.mk (functor C) (inverse C) (NatIso.ofComponents (fun X => Iso.refl X) (by tidy))
    (NatIso.ofComponents (fun X => Iso.refl X) (by tidy))
#align category_theory.shrink_homs.equivalence CategoryTheory.ShrinkHoms.equivalence

end ShrinkHoms

#print CategoryTheory.essentiallySmall_iff /-
/-- A category is essentially small if and only if
the underlying type of its skeleton (i.e. the "set" of isomorphism classes) is small,
and it is locally small.
-/
theorem essentiallySmall_iff (C : Type u) [Category.{v} C] :
    EssentiallySmall.{w} C ↔ Small.{w} (Skeleton C) ∧ LocallySmall.{w} C :=
  by
  -- This theorem is the only bit of real work in this file.
  fconstructor
  · intro h
    fconstructor
    · rcases h with ⟨S, 𝒮, ⟨e⟩⟩
      skip
      refine' ⟨⟨skeleton S, ⟨_⟩⟩⟩
      exact e.skeleton_equiv
    · skip
      infer_instance
  · rintro ⟨⟨S, ⟨e⟩⟩, L⟩
    skip
    let e' := (shrink_homs.equivalence C).skeletonEquiv.symm
    refine' ⟨⟨S, _, ⟨_⟩⟩⟩
    apply induced_category.category (e'.trans e).symm
    refine'
      (shrink_homs.equivalence C).trans
        ((skeleton_equivalence _).symm.trans (induced_functor (e'.trans e).symm).asEquivalence.symm)
#align category_theory.essentially_small_iff CategoryTheory.essentiallySmall_iff
-/

#print CategoryTheory.locallySmall_of_thin /-
/-- Any thin category is locally small.
-/
instance (priority := 100) locallySmall_of_thin {C : Type u} [Category.{v} C] [Quiver.IsThin C] :
    LocallySmall.{w} C where
#align category_theory.locally_small_of_thin CategoryTheory.locallySmall_of_thin
-/

#print CategoryTheory.essentiallySmall_iff_of_thin /-
/--
A thin category is essentially small if and only if the underlying type of its skeleton is small.
-/
theorem essentiallySmall_iff_of_thin {C : Type u} [Category.{v} C] [Quiver.IsThin C] :
    EssentiallySmall.{w} C ↔ Small.{w} (Skeleton C) := by
  simp [essentially_small_iff, CategoryTheory.locallySmall_of_thin]
#align category_theory.essentially_small_iff_of_thin CategoryTheory.essentiallySmall_iff_of_thin
-/

end CategoryTheory


/-
Copyright © 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Floris van Doorn
-/

import topology.vector_bundle.basic

/-!
# Direct sum of two vector bundles

If `E₁ : B → Type*` and `E₂ : B → Type*` define two topological vector bundles over `R` with fiber
models `F₁` and `F₂`, we define the bundle of direct sums `E₁ ×ᵇ E₂ := λ x, E₁ x × E₂ x`.
We can endow `E₁ ×ᵇ E₂` with a topological vector bundle structure:
`bundle.prod.topological_vector_bundle`.

A similar construction (which is yet to be formalized) can be done for the vector bundle of
continuous linear maps from `E₁ x` to `E₂ x` with fiber a type synonym
`vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂ x := (E₁ x →L[R] E₂ x)` (and with the
topology inherited from the norm-topology on `F₁ →L[R] F₂`, without the need to define the strong
topology on continuous linear maps between general topological vector spaces).  Likewise for tensor
products of topological vector bundles, exterior algebras, and so on, where the topology can be
defined using a norm on the fiber model if this helps.

## Tags
Vector bundle
-/

noncomputable theory

open bundle set
open_locale classical

variables (R 𝕜 : Type*) {B : Type*} (F : Type*) (E : B → Type*)

namespace topological_vector_bundle

section defs
variables (E₁ : B → Type*) (E₂ : B → Type*)
variables [topological_space (total_space E₁)] [topological_space (total_space E₂)]

/-- Equip the total space of the fibrewise product of two topological vector bundles `E₁`, `E₂` with
the induced topology from the diagonal embedding into `total_space E₁ × total_space E₂`. -/
instance prod.topological_space :
  topological_space (total_space (E₁ ×ᵇ E₂)) :=
topological_space.induced
  (λ p, ((⟨p.1, p.2.1⟩ : total_space E₁), (⟨p.1, p.2.2⟩ : total_space E₂)))
  (by apply_instance : topological_space (total_space E₁ × total_space E₂))

/-- The diagonal map from the total space of the fibrewise product of two topological vector bundles
`E₁`, `E₂` into `total_space E₁ × total_space E₂` is `inducing`. -/
lemma prod.inducing_diag : inducing
  (λ p, (⟨p.1, p.2.1⟩, ⟨p.1, p.2.2⟩) :
    total_space (E₁ ×ᵇ E₂) → total_space E₁ × total_space E₂) :=
⟨rfl⟩

end defs

variables [nondiscrete_normed_field R] [topological_space B]

variables (F₁ : Type*) [normed_group F₁] [normed_space R F₁]
  (E₁ : B → Type*) [topological_space (total_space E₁)]
  [Π x, add_comm_monoid (E₁ x)] [Π x, module R (E₁ x)]

variables (F₂ : Type*) [normed_group F₂] [normed_space R F₂]
  (E₂ : B → Type*) [topological_space (total_space E₂)]
  [Π x, add_comm_monoid (E₂ x)] [Π x, module R (E₂ x)]

namespace trivialization
variables (e₁ : trivialization R F₁ E₁) (e₂ : trivialization R F₂ E₂)
include e₁ e₂
variables {R F₁ E₁ F₂ E₂}

/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the forward
function for the construction `topological_vector_bundle.trivialization.prod`, the induced
trivialization for the direct sum of `E₁` and `E₂`. -/
def prod.to_fun' : total_space (E₁ ×ᵇ E₂) → B × (F₁ × F₂) :=
λ p, ⟨p.1, (e₁ ⟨p.1, p.2.1⟩).2, (e₂ ⟨p.1, p.2.2⟩).2⟩

variables {e₁ e₂}

lemma prod.continuous_to_fun : continuous_on (prod.to_fun' e₁ e₂)
  (@total_space.proj B (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :=
begin
  let f₁ : total_space (E₁ ×ᵇ E₂) → total_space E₁ × total_space E₂ :=
    λ p, ((⟨p.1, p.2.1⟩ : total_space E₁), (⟨p.1, p.2.2⟩ : total_space E₂)),
  let f₂ : total_space E₁ × total_space E₂ → (B × F₁) × (B × F₂) := λ p, ⟨e₁ p.1, e₂ p.2⟩,
  let f₃ : (B × F₁) × (B × F₂) → B × F₁ × F₂ := λ p, ⟨p.1.1, p.1.2, p.2.2⟩,
  have hf₁ : continuous f₁ := (prod.inducing_diag E₁ E₂).continuous,
  have hf₂ : continuous_on f₂ (e₁.source ×ˢ e₂.source) :=
    e₁.to_local_homeomorph.continuous_on.prod_map e₂.to_local_homeomorph.continuous_on,
  have hf₃ : continuous f₃ :=
    (continuous_fst.comp continuous_fst).prod_mk (continuous_snd.prod_map continuous_snd),
  refine ((hf₃.comp_continuous_on hf₂).comp hf₁.continuous_on _).congr _,
  { rw [e₁.source_eq, e₂.source_eq],
    exact maps_to_preimage _ _ },
  rintros ⟨b, v₁, v₂⟩ ⟨hb₁, hb₂⟩,
  simp only [prod.to_fun', prod.mk.inj_iff, eq_self_iff_true, and_true],
  rw e₁.coe_fst,
  rw [e₁.source_eq, mem_preimage],
  exact hb₁,
end

variables (e₁ e₂)

/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the inverse
function for the construction `topological_vector_bundle.trivialization.prod`, the induced
trivialization for the direct sum of `E₁` and `E₂`. -/
def prod.inv_fun' (p : B × (F₁ × F₂)) : total_space (E₁ ×ᵇ E₂) :=
⟨p.1, e₁.symm p.1 p.2.1, e₂.symm p.1 p.2.2⟩

variables {e₁ e₂}

lemma prod.left_inv {x : total_space (E₁ ×ᵇ E₂)}
  (h : x ∈ @total_space.proj B (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :
  prod.inv_fun' e₁ e₂ (prod.to_fun' e₁ e₂ x) = x :=
begin
  obtain ⟨x, v₁, v₂⟩ := x,
  obtain ⟨h₁ : x ∈ e₁.base_set, h₂ : x ∈ e₂.base_set⟩ := h,
  simp only [prod.to_fun', prod.inv_fun', symm_apply_apply_mk, h₁, h₂]
end

lemma prod.right_inv {x : B × F₁ × F₂}
  (h : x ∈ (e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))) :
  prod.to_fun' e₁ e₂ (prod.inv_fun' e₁ e₂ x) = x :=
begin
  obtain ⟨x, w₁, w₂⟩ := x,
  obtain ⟨⟨h₁ : x ∈ e₁.base_set, h₂ : x ∈ e₂.base_set⟩, -⟩ := h,
  simp only [prod.to_fun', prod.inv_fun', apply_mk_symm, h₁, h₂]
end

lemma prod.continuous_inv_fun :
  continuous_on (prod.inv_fun' e₁ e₂) ((e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))) :=
begin
  rw (prod.inducing_diag E₁ E₂).continuous_on_iff,
  have H₁ : continuous (λ p : B × F₁ × F₂, ((p.1, p.2.1), (p.1, p.2.2))) :=
    (continuous_id.prod_map continuous_fst).prod_mk (continuous_id.prod_map continuous_snd),
  refine (e₁.continuous_on_symm.prod_map e₂.continuous_on_symm).comp H₁.continuous_on _,
  exact λ x h, ⟨⟨h.1.1, mem_univ _⟩, ⟨h.1.2, mem_univ _⟩⟩
end

variables (e₁ e₂)
variables [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
  [topological_vector_bundle R F₁ E₁] [topological_vector_bundle R F₂ E₂]

/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the induced
trivialization for the direct sum of `E₁` and `E₂`, whose base set is `e₁.base_set ∩ e₂.base_set`.
-/
@[nolint unused_arguments]
def prod : trivialization R (F₁ × F₂) (E₁ ×ᵇ E₂) :=
{ to_fun := prod.to_fun' e₁ e₂,
  inv_fun := prod.inv_fun' e₁ e₂,
  source := (@total_space.proj B (E₁ ×ᵇ E₂)) ⁻¹' (e₁.base_set ∩ e₂.base_set),
  target := (e₁.base_set ∩ e₂.base_set) ×ˢ (set.univ : set (F₁ × F₂)),
  map_source' := λ x h, ⟨h, set.mem_univ _⟩,
  map_target' := λ x h, h.1,
  left_inv' := λ x, prod.left_inv,
  right_inv' := λ x, prod.right_inv,
  open_source := begin
    refine (e₁.open_base_set.inter e₂.open_base_set).preimage _,
    have : continuous (@total_space.proj B E₁) := continuous_proj R B F₁,
    exact this.comp (prod.inducing_diag E₁ E₂).continuous.fst,
  end,
  open_target := (e₁.open_base_set.inter e₂.open_base_set).prod is_open_univ,
  continuous_to_fun := prod.continuous_to_fun,
  continuous_inv_fun := prod.continuous_inv_fun,
  base_set := e₁.base_set ∩ e₂.base_set,
  open_base_set := e₁.open_base_set.inter e₂.open_base_set,
  source_eq := rfl,
  target_eq := rfl,
  proj_to_fun := λ x h, rfl,
  linear' := λ x ⟨h₁, h₂⟩, (((e₁.linear h₁).mk' _).prod_map ((e₂.linear h₂).mk' _)).is_linear }

@[simp] lemma base_set_prod : (prod e₁ e₂).base_set = e₁.base_set ∩ e₂.base_set :=
rfl

variables {e₁ e₂}

lemma prod_apply {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) (v₁ : E₁ x)
  (v₂ : E₂ x) :
  prod e₁ e₂ ⟨x, (v₁, v₂)⟩
  = ⟨x, e₁.continuous_linear_equiv_at x hx₁ v₁, e₂.continuous_linear_equiv_at x hx₂ v₂⟩ :=
rfl

lemma prod_symm_apply (x : B) (w₁ : F₁) (w₂ : F₂) : (prod e₁ e₂).to_local_equiv.symm (x, w₁, w₂)
  = ⟨x, e₁.symm x w₁, e₂.symm x w₂⟩ :=
rfl

end trivialization

open trivialization

variables [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
  [topological_vector_bundle R F₁ E₁] [topological_vector_bundle R F₂ E₂]

/-- The product of two vector bundles is a vector bundle. -/
instance _root_.bundle.prod.topological_vector_bundle :
  topological_vector_bundle R (F₁ × F₂) (E₁ ×ᵇ E₂) :=
{ total_space_mk_inducing := λ b,
  begin
    rw (prod.inducing_diag E₁ E₂).inducing_iff,
    exact (total_space_mk_inducing R F₁ E₁ b).prod_mk (total_space_mk_inducing R F₂ E₂ b),
  end,
  trivialization_atlas := (λ (p : trivialization R F₁ E₁ × trivialization R F₂ E₂), p.1.prod p.2) ''
    (trivialization_atlas R F₁ E₁ ×ˢ trivialization_atlas R F₂ E₂),
  trivialization_at := λ b, (trivialization_at R F₁ E₁ b).prod (trivialization_at R F₂ E₂ b),
  mem_base_set_trivialization_at :=
    λ b, ⟨mem_base_set_trivialization_at R F₁ E₁ b, mem_base_set_trivialization_at R F₂ E₂ b⟩,
  trivialization_mem_atlas := λ b,
    ⟨(_, _), ⟨trivialization_mem_atlas R F₁ E₁ b, trivialization_mem_atlas R F₂ E₂ b⟩, rfl⟩,
  continuous_on_coord_change := begin
    rintros _ ⟨⟨e₁, e₂⟩, ⟨he₁, he₂⟩, rfl⟩ _ ⟨⟨e₁', e₂'⟩, ⟨he₁', he₂'⟩, rfl⟩,
    have := continuous_on_coord_change e₁ he₁ e₁' he₁',
    have := continuous_on_coord_change e₂ he₂ e₂' he₂',
    refine (((continuous_on_coord_change e₁ he₁ e₁' he₁').mono _).prod_mapL R
      ((continuous_on_coord_change e₂ he₂ e₂' he₂').mono _)).congr _;
    dsimp only [base_set_prod] with mfld_simps,
    { mfld_set_tac },
    { mfld_set_tac },
    { rintro b hb,
      rw [continuous_linear_map.ext_iff],
      rintro ⟨v₁, v₂⟩,
      show (e₁.prod e₂).coord_change (e₁'.prod e₂') b (v₁, v₂) =
        (e₁.coord_change e₁' b v₁, e₂.coord_change e₂' b v₂),
      rw [e₁.coord_change_apply e₁', e₂.coord_change_apply e₂', (e₁.prod e₂).coord_change_apply'],
      exacts [rfl, hb, ⟨hb.1.2, hb.2.2⟩, ⟨hb.1.1, hb.2.1⟩] }
  end }

variables {R F₁ E₁ F₂ E₂}

@[simp] lemma trivialization.continuous_linear_equiv_at_prod {e₁ : trivialization R F₁ E₁}
  {e₂ : trivialization R F₂ E₂} {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) :
  (e₁.prod e₂).continuous_linear_equiv_at x ⟨hx₁, hx₂⟩
  = (e₁.continuous_linear_equiv_at x hx₁).prod (e₂.continuous_linear_equiv_at x hx₂) :=
begin
  ext1,
  funext v,
  obtain ⟨v₁, v₂⟩ := v,
  rw [(e₁.prod e₂).continuous_linear_equiv_at_apply, trivialization.prod],
  exact (congr_arg prod.snd (prod_apply hx₁ hx₂ v₁ v₂) : _)
end

end topological_vector_bundle


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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.equalizers
! leanprover-community/mathlib commit 4698e35ca56a0d4fa53aa5639c3364e0a77f4eba
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.SplitCoequalizer
import Mathlib.CategoryTheory.Limits.Preserves.Basic

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizerComparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,g`, as well as the dual result.
-/

noncomputable section

universe w v₁ v₂ u₁ u₂

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

variable {C : Type u₁} [Category.{v₁} C]

variable {D : Type u₂} [Category.{v₂} D]

variable (G : C ⥤ D)

namespace CategoryTheory.Limits

section Equalizers

variable {X Y Z : C} {f g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)

/-- The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `Fork.ofι` with `Functor.mapCone`.
-/
def isLimitMapConeForkEquiv :
    IsLimit (G.mapCone (Fork.ofι h w)) ≃
      IsLimit (Fork.ofι (G.map h) (by simp only [← G.map_comp, w]) : Fork (G.map f) (G.map g)) :=
  (IsLimit.postcomposeHomEquiv (diagramIsoParallelPair _) _).symm.trans
    (IsLimit.equivIsoLimit (Fork.ext (Iso.refl _) (by simp [Fork.ι])))
#align category_theory.limits.is_limit_map_cone_fork_equiv CategoryTheory.Limits.isLimitMapConeForkEquiv

/-- The property of preserving equalizers expressed in terms of forks. -/
def isLimitForkMapOfIsLimit [PreservesLimit (parallelPair f g) G] (l : IsLimit (Fork.ofι h w)) :
    IsLimit (Fork.ofι (G.map h) (by simp only [← G.map_comp, w]) : Fork (G.map f) (G.map g)) :=
  isLimitMapConeForkEquiv G w (PreservesLimit.preserves l)
#align category_theory.limits.is_limit_fork_map_of_is_limit CategoryTheory.Limits.isLimitForkMapOfIsLimit

/-- The property of reflecting equalizers expressed in terms of forks. -/
def isLimitOfIsLimitForkMap [ReflectsLimit (parallelPair f g) G]
    (l : IsLimit (Fork.ofι (G.map h) (by simp only [← G.map_comp, w]) : Fork (G.map f) (G.map g))) :
    IsLimit (Fork.ofι h w) :=
  ReflectsLimit.reflects ((isLimitMapConeForkEquiv G w).symm l)
#align category_theory.limits.is_limit_of_is_limit_fork_map CategoryTheory.Limits.isLimitOfIsLimitForkMap

variable (f g) [HasEqualizer f g]

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def isLimitOfHasEqualizerOfPreservesLimit [PreservesLimit (parallelPair f g) G] :
    IsLimit (Fork.ofι
      (G.map (equalizer.ι f g)) (by simp only [← G.map_comp]; rw [equalizer.condition]) :
      Fork (G.map f) (G.map g)) :=
  isLimitForkMapOfIsLimit G _ (equalizerIsEqualizer f g)
#align category_theory.limits.is_limit_of_has_equalizer_of_preserves_limit CategoryTheory.Limits.isLimitOfHasEqualizerOfPreservesLimit

variable [HasEqualizer (G.map f) (G.map g)]

/-- If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def PreservesEqualizer.ofIsoComparison [i : IsIso (equalizerComparison f g G)] :
    PreservesLimit (parallelPair f g) G := by
  apply preservesLimitOfPreservesLimitCone (equalizerIsEqualizer f g)
  apply (isLimitMapConeForkEquiv _ _).symm _
  refine @IsLimit.ofPointIso _ _ _ _ _ _ _ (limit.isLimit (parallelPair (G.map f) (G.map g))) ?_
  apply i
#align category_theory.limits.preserves_equalizer.of_iso_comparison CategoryTheory.Limits.PreservesEqualizer.ofIsoComparison

variable [PreservesLimit (parallelPair f g) G]

/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def PreservesEqualizer.iso : G.obj (equalizer f g) ≅ equalizer (G.map f) (G.map g) :=
  IsLimit.conePointUniqueUpToIso (isLimitOfHasEqualizerOfPreservesLimit G f g) (limit.isLimit _)
#align category_theory.limits.preserves_equalizer.iso CategoryTheory.Limits.PreservesEqualizer.iso

@[simp]
theorem PreservesEqualizer.iso_hom :
    (PreservesEqualizer.iso G f g).hom = equalizerComparison f g G :=
  rfl
#align category_theory.limits.preserves_equalizer.iso_hom CategoryTheory.Limits.PreservesEqualizer.iso_hom

instance : IsIso (equalizerComparison f g G) := by
  rw [← PreservesEqualizer.iso_hom]
  infer_instance

end Equalizers

section Coequalizers

variable {X Y Z : C} {f g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)

/-- The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `Cofork.ofπ` with `Functor.mapCocone`.
-/
def isColimitMapCoconeCoforkEquiv :
    IsColimit (G.mapCocone (Cofork.ofπ h w)) ≃
      IsColimit
        (Cofork.ofπ (G.map h) (by simp only [← G.map_comp, w]) : Cofork (G.map f) (G.map g)) :=
  (IsColimit.precomposeInvEquiv (diagramIsoParallelPair _) _).symm.trans <|
    IsColimit.equivIsoColimit <|
      Cofork.ext (Iso.refl _) <|
        by
        dsimp only [Cofork.π, Cofork.ofπ_ι_app]
        dsimp; rw [Category.comp_id, Category.id_comp]
#align category_theory.limits.is_colimit_map_cocone_cofork_equiv CategoryTheory.Limits.isColimitMapCoconeCoforkEquiv

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def isColimitCoforkMapOfIsColimit [PreservesColimit (parallelPair f g) G]
    (l : IsColimit (Cofork.ofπ h w)) :
    IsColimit
      (Cofork.ofπ (G.map h) (by simp only [← G.map_comp, w]) : Cofork (G.map f) (G.map g)) :=
  isColimitMapCoconeCoforkEquiv G w (PreservesColimit.preserves l)
#align category_theory.limits.is_colimit_cofork_map_of_is_colimit CategoryTheory.Limits.isColimitCoforkMapOfIsColimit

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def isColimitOfIsColimitCoforkMap [ReflectsColimit (parallelPair f g) G]
    (l :
      IsColimit
        (Cofork.ofπ (G.map h) (by simp only [← G.map_comp, w]) : Cofork (G.map f) (G.map g))) :
    IsColimit (Cofork.ofπ h w) :=
  ReflectsColimit.reflects ((isColimitMapCoconeCoforkEquiv G w).symm l)
#align category_theory.limits.is_colimit_of_is_colimit_cofork_map CategoryTheory.Limits.isColimitOfIsColimitCoforkMap

variable (f g) [HasCoequalizer f g]

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def isColimitOfHasCoequalizerOfPreservesColimit [PreservesColimit (parallelPair f g) G] :
    IsColimit (Cofork.ofπ (G.map (coequalizer.π f g)) (by
      simp only [← G.map_comp]; rw [coequalizer.condition]) : Cofork (G.map f) (G.map g)) :=
  isColimitCoforkMapOfIsColimit G _ (coequalizerIsCoequalizer f g)
#align category_theory.limits.is_colimit_of_has_coequalizer_of_preserves_colimit CategoryTheory.Limits.isColimitOfHasCoequalizerOfPreservesColimit

variable [HasCoequalizer (G.map f) (G.map g)]

/-- If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def ofIsoComparison [i : IsIso (coequalizerComparison f g G)] :
    PreservesColimit (parallelPair f g) G := by
  apply preservesColimitOfPreservesColimitCocone (coequalizerIsCoequalizer f g)
  apply (isColimitMapCoconeCoforkEquiv _ _).symm _
  refine
    @IsColimit.ofPointIso _ _ _ _ _ _ _ (colimit.isColimit (parallelPair (G.map f) (G.map g))) ?_
  apply i
#align category_theory.limits.of_iso_comparison CategoryTheory.Limits.ofIsoComparison

variable [PreservesColimit (parallelPair f g) G]

/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def PreservesCoequalizer.iso : coequalizer (G.map f) (G.map g) ≅ G.obj (coequalizer f g) :=
  IsColimit.coconePointUniqueUpToIso (colimit.isColimit _)
    (isColimitOfHasCoequalizerOfPreservesColimit G f g)
#align category_theory.limits.preserves_coequalizer.iso CategoryTheory.Limits.PreservesCoequalizer.iso

@[simp]
theorem PreservesCoequalizer.iso_hom :
    (PreservesCoequalizer.iso G f g).hom = coequalizerComparison f g G :=
  rfl
#align category_theory.limits.preserves_coequalizer.iso_hom CategoryTheory.Limits.PreservesCoequalizer.iso_hom

instance : IsIso (coequalizerComparison f g G) := by
  rw [← PreservesCoequalizer.iso_hom]
  infer_instance

instance map_π_epi : Epi (G.map (coequalizer.π f g)) :=
  ⟨fun {W} h k => by
    rw [← ι_comp_coequalizerComparison]
    haveI : Epi (coequalizer.π (G.map f) (G.map g) ≫ coequalizerComparison f g G) := by
      apply epi_comp
    apply (cancel_epi _).1⟩
#align category_theory.limits.map_π_epi CategoryTheory.Limits.map_π_epi

@[reassoc]
theorem map_π_preserves_coequalizer_inv :
    G.map (coequalizer.π f g) ≫ (PreservesCoequalizer.iso G f g).inv =
      coequalizer.π (G.map f) (G.map g) := by
  rw [← ι_comp_coequalizerComparison_assoc, ← PreservesCoequalizer.iso_hom, Iso.hom_inv_id,
    comp_id]
#align category_theory.limits.map_π_preserves_coequalizer_inv CategoryTheory.Limits.map_π_preserves_coequalizer_inv

@[reassoc]
theorem map_π_preserves_coequalizer_inv_desc {W : D} (k : G.obj Y ⟶ W)
    (wk : G.map f ≫ k = G.map g ≫ k) :
    G.map (coequalizer.π f g) ≫ (PreservesCoequalizer.iso G f g).inv ≫ coequalizer.desc k wk = k :=
  by rw [← Category.assoc, map_π_preserves_coequalizer_inv, coequalizer.π_desc]
#align category_theory.limits.map_π_preserves_coequalizer_inv_desc CategoryTheory.Limits.map_π_preserves_coequalizer_inv_desc

@[reassoc]
theorem map_π_preserves_coequalizer_inv_colimMap {X' Y' : D} (f' g' : X' ⟶ Y')
    [HasCoequalizer f' g'] (p : G.obj X ⟶ X') (q : G.obj Y ⟶ Y') (wf : G.map f ≫ q = p ≫ f')
    (wg : G.map g ≫ q = p ≫ g') :
    G.map (coequalizer.π f g) ≫
        (PreservesCoequalizer.iso G f g).inv ≫
          colimMap (parallelPairHom (G.map f) (G.map g) f' g' p q wf wg) =
      q ≫ coequalizer.π f' g' :=
  by rw [← Category.assoc, map_π_preserves_coequalizer_inv, ι_colimMap, parallelPairHom_app_one]
#align category_theory.limits.map_π_preserves_coequalizer_inv_colim_map CategoryTheory.Limits.map_π_preserves_coequalizer_inv_colimMap

@[reassoc]
theorem map_π_preserves_coequalizer_inv_colimMap_desc {X' Y' : D} (f' g' : X' ⟶ Y')
    [HasCoequalizer f' g'] (p : G.obj X ⟶ X') (q : G.obj Y ⟶ Y') (wf : G.map f ≫ q = p ≫ f')
    (wg : G.map g ≫ q = p ≫ g') {Z' : D} (h : Y' ⟶ Z') (wh : f' ≫ h = g' ≫ h) :
    G.map (coequalizer.π f g) ≫
        (PreservesCoequalizer.iso G f g).inv ≫
          colimMap (parallelPairHom (G.map f) (G.map g) f' g' p q wf wg) ≫ coequalizer.desc h wh =
      q ≫ h := by
  slice_lhs 1 3 => rw [map_π_preserves_coequalizer_inv_colimMap]
  slice_lhs 2 3 => rw [coequalizer.π_desc]
#align category_theory.limits.map_π_preserves_coequalizer_inv_colim_map_desc CategoryTheory.Limits.map_π_preserves_coequalizer_inv_colimMap_desc

/-- Any functor preserves coequalizers of split pairs. -/
instance (priority := 1) preservesSplitCoequalizers (f g : X ⟶ Y) [HasSplitCoequalizer f g] :
    PreservesColimit (parallelPair f g) G := by
  apply
    preservesColimitOfPreservesColimitCocone
      (HasSplitCoequalizer.isSplitCoequalizer f g).isCoequalizer
  apply
    (isColimitMapCoconeCoforkEquiv G _).symm
      ((HasSplitCoequalizer.isSplitCoequalizer f g).map G).isCoequalizer
#align category_theory.limits.preserves_split_coequalizers CategoryTheory.Limits.preservesSplitCoequalizers

end Coequalizers

end CategoryTheory.Limits


import analysis.normed.group.basic
import topology.algebra.infinite_sum
import for_mathlib.AddCommGroup.exact
import for_mathlib.free_abelian_group2

noncomputable theory

open category_theory
open_locale big_operators

variables (A : Type*) [add_comm_group A]

namespace free_abelian_group

def σπ : free_abelian_group (A × A) →+ free_abelian_group A :=
free_abelian_group.map prod.fst + free_abelian_group.map prod.snd -
free_abelian_group.map (function.uncurry (+))

lemma σπ_of (x) : σπ A (of x) = (of x.1) + (of x.2) - of (x.1 + x.2) :=
by simp only [σπ, add_monoid_hom.sub_apply, add_monoid_hom.add_apply, map_of_apply, function.uncurry]

lemma σπ_comp_zero : AddCommGroup.of_hom (σπ A) ≫ AddCommGroup.of_hom (lift id) = 0 :=
begin
  ext ⟨x,y⟩,
  simp only [comp_apply, AddCommGroup.of_hom_apply, σπ_of, _root_.map_sub, _root_.map_add,
    lift.of, id.def, sub_self, AddCommGroup.zero_apply],
end

section norm

open_locale nnreal

variables {X : Type*} (a b : free_abelian_group X)

def norm : ℕ := ∑ x in a.support, (coeff x a).nat_abs

lemma tsum_norm : (a.norm : ℝ) = ∑' x, |((coeff x a) : ℝ)| :=
begin
  rw [@tsum_eq_sum _ _ _ _ _ (λ x : X, |((coeff x a) : ℝ)|) a.support _, norm, nat.cast_sum],
  apply finset.sum_congr (refl a.support),
  { exact (λ x _, (int.cast_nat_abs _))} ,
  { intros x hx,
    rw [abs_eq_zero, int.cast_eq_zero],
    exact (not_mem_support_iff x a).mp hx },
end

lemma summable_tsum_norm : summable (λ x, |((coeff x a) : ℝ)|) :=
begin
  apply summable_of_ne_finset_zero,
  { intros x hx,
    rw [abs_eq_zero, int.cast_eq_zero],
    exact (not_mem_support_iff x a).mp hx },
end

@[simp] lemma norm_of (x : X) : (of x).norm = 1 := by {simp only [norm, support_of,
  finset.sum_singleton, coeff_of_self, int.nat_abs_one]}

lemma norm_add : (a + b).norm ≤ a.norm + b.norm :=
begin
  rw [← @nat.cast_le ℝ _ _, tsum_norm, nat.cast_add, tsum_norm, tsum_norm, ← tsum_add
    (summable_tsum_norm a) (summable_tsum_norm b)],
  refine tsum_le_tsum _
    (summable_tsum_norm (a + b) ) (summable.add (summable_tsum_norm _) (summable_tsum_norm _)),
  intro,
  rw [_root_.map_add, int.cast_add],
  exact abs_add _ _ ,
end

@[simp] lemma norm_neg : (-a).norm = a.norm :=
begin
  apply_fun (coe : ℕ → ℝ),
  { rw [tsum_norm, tsum_norm, tsum_congr],
    intro x,
    rw [_root_.map_neg, int.cast_neg, abs_neg] },
  exact nat.cast_injective,
end

lemma norm_sub : (a - b).norm ≤ a.norm + b.norm := by {rw [sub_eq_add_neg, ← norm_neg b],
  exact norm_add _ _}

@[simp] lemma norm_eq_zero_iff : a.norm = 0 ↔ a = 0 :=
begin
  split,
  { intro h,
    rw [← @nat.cast_eq_zero ℝ _ _ _, tsum_norm] at h,
    have H := (has_sum_zero_iff_of_nonneg _).mp (((summable_tsum_norm a).has_sum_iff).mpr h),
    have h_cz : ∀ x : X, coeff x a = 0,
    { intro x,
      have := (function.funext_iff).mp H x,
      simp only [pi.zero_apply, abs_eq_zero, int.cast_eq_zero] at this,
      exact this },
    apply_fun to_finsupp,
    ext,
    exacts [h_cz _, add_equiv.injective (equiv_finsupp X), (λ _, abs_nonneg _)] },
  { intro h,
    have h_cz : ∀ x : X, coeff x a = 0,
    { intro x,
      rw h,
      simp only [_root_.map_zero, eq_self_iff_true] },
    apply finset.sum_eq_zero,
    rintros x -,
    exact (int.nat_abs_eq_zero.mpr (h_cz x))}
end

lemma exists_of_norm_eq_succ_aux1 (n : ℤ) (H : 0 < n) :
  n.nat_abs = (n - 1).nat_abs + 1 :=
begin
  rcases n with ((_|n)|n),
  { exfalso, revert H, dec_trivial },
  { suffices : int.of_nat n.succ - 1 = int.of_nat n, { rw this, refl, },
    simp only [int.of_nat_eq_coe, int.coe_nat_succ, add_tsub_cancel_right], },
  { exfalso, revert H, dec_trivial },
end

lemma exists_of_norm_eq_succ_aux2 (n : ℤ) (H : n < 0) :
  n.nat_abs = (n + 1).nat_abs + 1 :=
begin
  rw [← right.neg_pos_iff] at H,
  simpa only [int.nat_abs_neg, sub_eq_add_neg, ← neg_add] using
    exists_of_norm_eq_succ_aux1 (-n) H,
end

lemma exists_of_norm_eq_succ (n : ℕ) (han : a.norm = n.succ) :
  ∃ b x, (a = b + of x ∨ a = b - of x) ∧ b.norm = n :=
begin
  have aux : a.norm ≠ 0, { rw han, dec_trivial },
  dsimp [norm] at aux,
  erw not_iff_not.mpr finset.sum_eq_zero_iff at aux, push_neg at aux,
  rcases aux with ⟨x, hxa, ha⟩,
  rcases lt_trichotomy (coeff x a) 0 with (H|H|H), rotate,
  { apply_fun int.nat_abs at H, contradiction },
  { refine ⟨a - of x, x, or.inl (sub_add_cancel _ _).symm, _⟩,
    apply nat.succ_injective, rw [← han], symmetry,
    dsimp only [norm, nat.succ_eq_add_one],
    classical,
    have : (a - of x).support ⊆ a.support,
    { rw [sub_eq_add_neg], refine (support_add _ _).trans _,
      simp only [support_neg, support_of, finset.union_subset_iff, finset.subset.refl,
        finset.singleton_subset_iff, true_and, hxa], },
    rw [finset.sum_subset this],
    swap, { intros y hy1 hy2, rwa [int.nat_abs_eq_zero, ← not_mem_support_iff] },
    rw [← finset.insert_erase hxa, finset.sum_insert (finset.not_mem_erase _ _),
      finset.sum_insert (finset.not_mem_erase _ _), add_right_comm],
    simp only [_root_.map_sub], congr' 1,
    { rw [coeff_of_self], apply exists_of_norm_eq_succ_aux1 _ H },
    { refine finset.sum_congr rfl _, intros y hy, rw [coeff_of_not_mem_support (of x), sub_zero],
      simp only [finset.mem_erase, ne.def] at hy,
      simpa only [support_of, finset.mem_singleton] using hy.1, } },
  { refine ⟨a + of x, x, or.inr (add_sub_cancel _ _).symm, _⟩,
    apply nat.succ_injective, rw [← han], symmetry,
    dsimp only [norm, nat.succ_eq_add_one],
    classical,
    have : (a + of x).support ⊆ a.support,
    { refine (support_add _ _).trans _,
      simp only [support_neg, support_of, finset.union_subset_iff, finset.subset.refl,
        finset.singleton_subset_iff, true_and, hxa], },
    rw [finset.sum_subset this],
    swap, { intros y hy1 hy2, rwa [int.nat_abs_eq_zero, ← not_mem_support_iff] },
    rw [← finset.insert_erase hxa, finset.sum_insert (finset.not_mem_erase _ _),
      finset.sum_insert (finset.not_mem_erase _ _), add_right_comm],
    simp only [_root_.map_add], congr' 1,
    { rw [coeff_of_self], apply exists_of_norm_eq_succ_aux2 _ H },
    { refine finset.sum_congr rfl _, intros y hy, rw [coeff_of_not_mem_support (of x), add_zero],
      simp only [finset.mem_erase, ne.def] at hy,
      simpa only [support_of, finset.mem_singleton] using hy.1, } },
end

-- SELFCONTAINED
lemma norm_eq_one_iff : a.norm = 1 ↔ ∃ x, a = of x ∨ a = -of x :=
begin
  -- have := exists_of_norm_eq_succ a 0,
  split,
  {intro h,
    have := (exists_of_norm_eq_succ a 0 h),
    simp only [norm_eq_zero_iff, exists_and_distrib_right, exists_eq_right, zero_add, zero_sub]
    at this,
    exact this },
  { intro h,
    rcases h with ⟨x, hx | hx⟩,
    all_goals { rw hx},
    any_goals {rw norm_neg},
    all_goals {exact norm_of x}},
end

end norm

lemma σπ_of_00 : σπ A (of (0,0)) = of 0 :=
by simp only [σπ_of, add_zero, add_sub_cancel']

lemma exact_σπ_induction (a : free_abelian_group A) (ha : free_abelian_group.lift id a = 0)
  (n : ℕ) (hn : a.norm ≤ n) :
  ∃ x, free_abelian_group.σπ A x = a :=
begin
  induction n with n ih generalizing a,
  { simp only [le_zero_iff, norm_eq_zero_iff] at hn, subst a, exact ⟨0, _root_.map_zero _⟩ },
  erw [nat.le_add_one_iff] at hn, cases hn with hn hn, { exact ih a ha hn },
  cases n,
  { rw [norm_eq_one_iff] at hn, rcases hn with ⟨a, (rfl|rfl)⟩,
    all_goals { simp only [lift.of, _root_.map_neg, _root_.id, neg_eq_zero] at ha, subst a, },
    { exact ⟨of (0,0), σπ_of_00 _⟩ },
    { refine ⟨-of (0,0), _⟩, rw [_root_.map_neg, σπ_of_00] } },
  obtain ⟨b, y, H1, hbn⟩ := exists_of_norm_eq_succ _ _ hn,
  obtain ⟨c, x, H2, hcn⟩ := exists_of_norm_eq_succ _ _ hbn,
  rcases H1 with (rfl|rfl); rcases H2 with (rfl|rfl),
  { obtain ⟨p, hp⟩ := ih (c + of (x+y)) _ _, rotate,
    { simpa only [lift.of, _root_.map_add, id.def, add_assoc] using ha, },
    { refine (norm_add _ _).trans _, rw [hcn, norm_of], },
    refine ⟨p + of (x,y), _⟩,
    simp only [_root_.map_add, hp, σπ_of, add_assoc, add_right_inj],
    rw [add_comm (of (x+y)), sub_add_cancel], },
  { obtain ⟨p, hp⟩ := ih (c + of (y-x)) _ _, rotate,
    { simpa only [lift.of, _root_.map_add, _root_.map_neg, id.def,
        add_assoc, sub_eq_add_neg, add_comm y] using ha, },
    { refine (norm_add _ _).trans _, rw [hcn, norm_of], },
    refine ⟨p - of (y-x,x), _⟩,
    simp only [_root_.map_add, _root_.map_neg, sub_eq_add_neg, hp, σπ_of,
      neg_add_cancel_right, neg_add_rev, neg_neg, add_assoc,
      add_left_neg, add_zero, add_right_inj],
    rw [add_comm (of (y+-x)), add_comm _ (of y)],
    simp only [add_assoc, add_left_neg, add_zero], },
  { obtain ⟨p, hp⟩ := ih (c + of (x-y)) _ _, rotate,
    { simpa only [lift.of, _root_.map_add, _root_.map_neg, id.def,
        add_assoc, sub_eq_add_neg] using ha, },
    { refine (norm_add _ _).trans _, rw [hcn, norm_of], },
    refine ⟨p - of (x-y,y), _⟩,
    simp only [_root_.map_add, _root_.map_neg, sub_eq_add_neg, hp, σπ_of,
      neg_add_cancel_right, neg_add_rev, neg_neg, add_assoc, add_right_inj,
      add_left_neg, add_zero],
    rw [add_comm (of (x+-y))],
    simp only [add_assoc, add_left_neg, add_zero], },
  { obtain ⟨p, hp⟩ := ih (c - of (x+y)) _ _, rotate,
    { simpa only [lift.of, _root_.map_add, _root_.map_neg, id.def, neg_add,
        add_assoc, sub_eq_add_neg] using ha, },
    { refine (norm_sub _ _).trans _, rw [hcn, norm_of], },
    refine ⟨p - of (x,y), _⟩,
    simp only [_root_.map_add, _root_.map_neg, sub_eq_add_neg, hp, σπ_of,
      neg_add_cancel_right, neg_add_rev, neg_neg, add_assoc, neg_add_cancel_left],
    rw add_comm (-of x) },
end

lemma exact_σπ : exact
  (AddCommGroup.of_hom $ free_abelian_group.σπ A)
  (AddCommGroup.of_hom $ free_abelian_group.lift id) :=
begin
  rw AddCommGroup.exact_iff',
  refine ⟨σπ_comp_zero _, _⟩,
  intros a ha,
  obtain ⟨p, hp⟩ := exact_σπ_induction A a ha a.norm le_rfl,
  exact ⟨p, hp⟩
end

end free_abelian_group


import galois.nat.simplify_le

namespace galois.tactic.nat

open nat
open tactic

local attribute [simp]  nat.succ_le_succ_iff
local attribute [simp]  nat.not_succ_le_zero

theorem one_add_bit1 (x : ℕ) : 1 + bit1 x = bit0 (1 + x) :=
begin
  cases x,
  { simp, },
  { simp [succ_add, bit1, bit0], },
end

theorem bit0_add_one (x : ℕ) : bit0 x + 1 = bit1 x :=
begin
  simp [bit1],
end

theorem bit0_add_bit0 (x y : ℕ) : bit0 x + bit0 y = bit0 (x + y) :=
begin
  cases x,
  { simp [bit0], },
  { simp [succ_add, add_succ, bit0], },
end

theorem bit1_add_one (x : ℕ) : bit1 x + 1 = bit0 (x + 1) :=
begin
  cases x,
  { simp [bit0, bit1], },
  { simp [succ_add, add_succ, bit1, bit0], },
end

theorem bit1_add_bit1 (x y : ℕ) : bit1 x + bit1 y = bit0 (x + y + 1) :=
begin
  cases x,
  { simp [bit0, bit1], },
  { simp [succ_add, add_succ, bit1, bit0], },
end

theorem one_le_bit0 (x : ℕ) : (1 ≤ bit0 x) ↔ (1 ≤ x) :=
begin
  cases x,
  { simp [bit0], },
  { simp [bit0, zero_le], },
end

theorem one_le_bit1 (x : ℕ) : (1 ≤ bit1 x) ↔ true :=
begin
  cases x,
  { simp [bit0], },
  { simp [bit0, bit1, add_succ, zero_le], },
end

theorem bit0_le_bit0 (x y : ℕ) : (bit0 x ≤ bit0 y) ↔ (x ≤ y) :=
begin
  revert y,
  induction x with x ind,
  { simp [zero_le], },
  { intro y,
    cases y with y,
    { simp [bit0, succ_add, not_succ_le_zero], },
    { simp [bit0, succ_add, add_succ],
      simp [bit0] at ind,
      apply ind,
    },
  },
end

theorem bit0_le_bit1 (x y : ℕ) : (bit0 x ≤ bit1 y) ↔ (x ≤ y) :=
begin
  revert y,
  induction x with x ind,
  { simp [zero_le], },
  { intro y,
    cases y with y,
    { simp [bit0, bit1, add_succ ], },
    { simp [bit0, bit1, add_succ, succ_add],
      simp [bit0, bit1, add_succ] at ind,
      apply ind,
    }
  },
end

theorem bit1_le_bit0 (x y : ℕ) : (bit1 x ≤ bit0 y) ↔ (x + 1 ≤ y) :=
begin
  revert y,
  induction x with x ind,
  { intro y,
    cases y with y,
    { simp [bit1, bit0], },
    { simp [bit1, bit0, zero_le], },
  },
  { intro y,
    cases y with y,
    { simp [bit0, bit1, add_succ], },
    { simp [bit0, bit1, add_succ, succ_add],
      simp [bit0, bit1, add_succ] at ind,
      apply ind,
    },
  },
end

theorem bit1_le_bit1 (x y : ℕ) : (bit1 x ≤ bit1 y) ↔ (x ≤ y) :=
begin
  revert y,
  induction x with x ind,
  { simp [zero_le, bit1, bit0, add_succ], },
  { intro y,
    cases y with y,
    { simp [bit0, bit1, add_succ], },
    { simp [bit0, bit1, add_succ, succ_add],
      simp [bit0, bit1, add_succ] at ind,
      apply ind,
    }
  },
end

meta def nat_lit_le : tactic unit := do
  let lemmas : list expr :=
    [ expr.const `norm_num.bin_zero_add [level.zero]

    , expr.const `norm_num.one_add_one  [level.zero]
    , expr.const `norm_num.one_add_bit0 [level.zero]
    , expr.const `galois.tactic.nat.one_add_bit1 []

    , expr.const `galois.tactic.nat.bit0_add_one []
    , expr.const `galois.tactic.nat.bit0_add_bit0 []
    , expr.const `norm_num.bit0_add_bit1 [level.zero]

    , expr.const `galois.tactic.nat.bit1_add_one []
    , expr.const `norm_num.bit1_add_bit0 [level.zero]
    , expr.const `galois.tactic.nat.bit1_add_bit1 []

    , expr.const `norm_num.mul_zero [level.zero]
    , expr.const `norm_num.mul_one  [level.zero]
    , expr.const `norm_num.mul_bit0 [level.zero]
    , expr.const `norm_num.mul_bit1 [level.zero]

    , expr.const `nat.zero_le []
    , expr.const `nat.le_refl []
    , expr.const `galois.tactic.nat.one_le_bit0 []
    , expr.const `galois.tactic.nat.one_le_bit1 []
    , expr.const `galois.tactic.nat.bit0_le_bit0 []
    , expr.const `galois.tactic.nat.bit0_le_bit1 []
    , expr.const `galois.tactic.nat.bit1_le_bit0 []
    , expr.const `galois.tactic.nat.bit1_le_bit1 []
    ] in do
  s ← simp_lemmas.mk_default,
  s ← s.append lemmas,
  tactic.simp_target s,
  try tactic.triv

open tactic
open monad

end galois.tactic.nat