/-
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.tactic

/-!
# Ordering on topologies and (co)induced topologies

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

Topologies on a fixed type `α` are ordered, by reverse inclusion.
That is, for topologies `t₁` and `t₂` on `α`, we write `t₁ ≤ t₂`
if every set open in `t₂` is also open in `t₁`.
(One also calls `t₁` finer than `t₂`, and `t₂` coarser than `t₁`.)

Any function `f : α → β` induces
       `induced f : topological_space β → topological_space α`
and  `coinduced f : topological_space α → topological_space β`.
Continuity, the ordering on topologies and (co)induced topologies are
related as follows:
* The identity map (α, t₁) → (α, t₂) is continuous iff t₁ ≤ t₂.
* A map f : (α, t) → (β, u) is continuous
    iff             t ≤ induced f u   (`continuous_iff_le_induced`)
    iff coinduced f t ≤ u             (`continuous_iff_coinduced_le`).

Topologies on α form a complete lattice, with ⊥ the discrete topology
and ⊤ the indiscrete topology.

For a function f : α → β, (coinduced f, induced f) is a Galois connection
between topologies on α and topologies on β.

## Implementation notes

There is a Galois insertion between topologies on α (with the inclusion ordering)
and all collections of sets in α. The complete lattice structure on topologies
on α is defined as the reverse of the one obtained via this Galois insertion.

## Tags

finer, coarser, induced topology, coinduced topology

-/

open function set filter
open_locale topology filter

universes u v w

namespace topological_space
variables {α : Type u}

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generate_open (g : set (set α)) : set α → Prop
| basic  : ∀s∈g, generate_open s
| univ   : generate_open univ
| inter  : ∀s t, generate_open s → generate_open t → generate_open (s ∩ t)
| sUnion : ∀k, (∀s∈k, generate_open s) → generate_open (⋃₀ k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from (g : set (set α)) : topological_space α :=
{ is_open        := generate_open g,
  is_open_univ   := generate_open.univ,
  is_open_inter  := generate_open.inter,
  is_open_sUnion := generate_open.sUnion }

lemma is_open_generate_from_of_mem {g : set (set α)} {s : set α} (hs : s ∈ g) :
  is_open[generate_from g] s :=
generate_open.basic s hs

lemma nhds_generate_from {g : set (set α)} {a : α} :
  @nhds α (generate_from g) a = (⨅s∈{s | a ∈ s ∧ s ∈ g}, 𝓟 s) :=
begin
  rw nhds_def,
  refine le_antisymm (binfi_mono $ λ s ⟨as, sg⟩, ⟨as, generate_open.basic _ sg⟩) _,
  refine le_infi₂ (λ s hs, _), cases hs with ha hs,
  induction hs,
  case basic : s hs { exact infi₂_le _ ⟨ha, hs⟩ },
  case univ : { exact le_top.trans_eq principal_univ.symm },
  case inter : s t hs' ht' hs ht { exact (le_inf (hs ha.1) (ht ha.2)).trans_eq inf_principal },
  case sUnion : S hS' hS
  { rcases ha with  ⟨t, htS, hat⟩,
    exact (hS t htS hat).trans (principal_mono.2 $ subset_sUnion_of_mem htS) }
end

lemma tendsto_nhds_generate_from {β : Type*} {m : α → β} {f : filter α} {g : set (set β)} {b : β}
  (h : ∀s∈g, b ∈ s → m ⁻¹' s ∈ f) : tendsto m f (@nhds β (generate_from g) b) :=
by rw [nhds_generate_from]; exact
  (tendsto_infi.2 $ assume s, tendsto_infi.2 $ assume ⟨hbs, hsg⟩, tendsto_principal.2 $ h s hsg hbs)

/-- Construct a topology on α given the filter of neighborhoods of each point of α. -/
protected def mk_of_nhds (n : α → filter α) : topological_space α :=
{ is_open        := λs, ∀a∈s, s ∈ n a,
  is_open_univ   := assume x h, univ_mem,
  is_open_inter  := assume s t hs ht x ⟨hxs, hxt⟩, inter_mem (hs x hxs) (ht x hxt),
  is_open_sUnion := assume s hs a ⟨x, hx, hxa⟩,
    mem_of_superset (hs x hx _ hxa) (set.subset_sUnion_of_mem hx) }

lemma nhds_mk_of_nhds (n : α → filter α) (a : α)
  (h₀ : pure ≤ n) (h₁ : ∀ a s, s ∈ n a → ∃ t ∈ n a, t ⊆ s ∧ ∀a' ∈ t, s ∈ n a') :
  @nhds α (topological_space.mk_of_nhds n) a = n a :=
begin
  letI := topological_space.mk_of_nhds n,
  refine le_antisymm (assume s hs, _) (assume s hs, _),
  { have h₀ : {b | s ∈ n b} ⊆ s := assume b hb, mem_pure.1 $ h₀ b hb,
    have h₁ : {b | s ∈ n b} ∈ 𝓝 a,
    { refine is_open.mem_nhds (assume b (hb : s ∈ n b), _) hs,
      rcases h₁ _ _ hb with ⟨t, ht, hts, h⟩,
      exact mem_of_superset ht h },
    exact mem_of_superset h₁ h₀ },
  { rcases (@mem_nhds_iff α (topological_space.mk_of_nhds n) _ _).1 hs with ⟨t, hts, ht, hat⟩,
    exact (n a).sets_of_superset (ht _ hat) hts },
end

lemma nhds_mk_of_nhds_single [decidable_eq α] {a₀ : α} {l : filter α} (h : pure a₀ ≤ l) (b : α) :
  @nhds α (topological_space.mk_of_nhds $ update pure a₀ l) b =
    (update pure a₀ l : α → filter α) b :=
begin
  refine nhds_mk_of_nhds _ _ (le_update_iff.mpr ⟨h, λ _ _, le_rfl⟩) (λ a s hs, _),
  rcases eq_or_ne a a₀ with rfl|ha,
  { refine ⟨s, hs, subset.rfl, λ b hb, _⟩,
    rcases eq_or_ne b a with rfl|hb,
    { exact hs },
    { rwa [update_noteq hb] } },
  { have hs' := hs,
    rw [update_noteq ha] at hs ⊢,
    exact ⟨{a}, rfl, singleton_subset_iff.mpr hs, forall_eq.2 hs'⟩ }
end

lemma nhds_mk_of_nhds_filter_basis (B : α → filter_basis α) (a : α) (h₀ : ∀ x (n ∈ B x), x ∈ n)
  (h₁ : ∀ x (n ∈ B x), ∃ n₁ ∈ B x, n₁ ⊆ n ∧ ∀ x' ∈ n₁, ∃ n₂ ∈ B x', n₂ ⊆ n) :
  @nhds α (topological_space.mk_of_nhds (λ x, (B x).filter)) a = (B a).filter :=
begin
  rw topological_space.nhds_mk_of_nhds;
  intros x n hn;
  obtain ⟨m, hm₁, hm₂⟩ := (B x).mem_filter_iff.mp hn,
  { exact hm₂ (h₀ _ _ hm₁), },
  { obtain ⟨n₁, hn₁, hn₂, hn₃⟩ := h₁ x m hm₁,
    refine ⟨n₁, (B x).mem_filter_of_mem hn₁, hn₂.trans hm₂, λ x' hx', (B x').mem_filter_iff.mp _⟩,
    obtain ⟨n₂, hn₄, hn₅⟩ := hn₃ x' hx',
    exact ⟨n₂, hn₄, hn₅.trans hm₂⟩, },
end

section lattice

/-- The ordering on topologies on the type `α`. `t ≤ s` if every set open in `s` is also open in `t`
(`t` is finer than `s`). -/
instance : partial_order (topological_space α) :=
{ le := λ s t, ∀ U, is_open[t] U → is_open[s] U,
  .. partial_order.lift (λ s, order_dual.to_dual (is_open[s])) (λ _ _, topological_space_eq) }

protected lemma le_def {α} {t s : topological_space α} : t ≤ s ↔ is_open[s] ≤ is_open[t] :=
iff.rfl

lemma le_generate_from_iff_subset_is_open {g : set (set α)} {t : topological_space α} :
  t ≤ topological_space.generate_from g ↔ g ⊆ {s | is_open[t] s} :=
⟨λ ht s hs, ht _ $ generate_open.basic s hs, λ hg s hs, hs.rec_on (assume v hv, hg hv)
  t.is_open_univ (assume u v _ _, t.is_open_inter u v) (assume k _, t.is_open_sUnion k)⟩

/-- If `s` equals the collection of open sets in the topology it generates, then `s` defines a
topology. -/
protected def mk_of_closure (s : set (set α)) (hs : {u | generate_open s u} = s) :
  topological_space α :=
{ is_open        := λ u, u ∈ s,
  is_open_univ   := hs ▸ topological_space.generate_open.univ,
  is_open_inter  := hs ▸ topological_space.generate_open.inter,
  is_open_sUnion := hs ▸ topological_space.generate_open.sUnion }

lemma mk_of_closure_sets {s : set (set α)} {hs : {u | generate_open s u} = s} :
  topological_space.mk_of_closure s hs = topological_space.generate_from s :=
topological_space_eq hs.symm

lemma gc_generate_from (α) :
  galois_connection (λ t : topological_space α, order_dual.to_dual {s | is_open[t] s})
    (generate_from ∘ order_dual.of_dual) :=
λ _ _, le_generate_from_iff_subset_is_open.symm

/-- The Galois coinsertion between `topological_space α` and `(set (set α))ᵒᵈ` whose lower part
  sends a topology to its collection of open subsets, and whose upper part sends a collection of
  subsets of α to the topology they generate. -/
def gci_generate_from (α : Type*) :
  galois_coinsertion (λ t : topological_space α, order_dual.to_dual {s | is_open[t] s})
    (generate_from ∘ order_dual.of_dual)  :=
{ gc        := gc_generate_from α,
  u_l_le    := assume ts s hs, generate_open.basic s hs,
  choice    := λg hg, topological_space.mk_of_closure g
    (subset.antisymm hg $ le_generate_from_iff_subset_is_open.1 $ le_rfl),
  choice_eq := assume s hs, mk_of_closure_sets }

/-- Topologies on `α` form a complete lattice, with `⊥` the discrete topology
  and `⊤` the indiscrete topology. The infimum of a collection of topologies
  is the topology generated by all their open sets, while the supremum is the
  topology whose open sets are those sets open in every member of the collection. -/
instance : complete_lattice (topological_space α) :=
(gci_generate_from α).lift_complete_lattice

@[mono] lemma generate_from_anti {α} {g₁ g₂ : set (set α)} (h : g₁ ⊆ g₂) :
  generate_from g₂ ≤ generate_from g₁ :=
(gc_generate_from _).monotone_u h

lemma generate_from_set_of_is_open (t : topological_space α) :
  generate_from {s | is_open[t] s} = t :=
(gci_generate_from α).u_l_eq t

lemma left_inverse_generate_from :
  left_inverse generate_from (λ t : topological_space α, {s | is_open[t] s}) :=
(gci_generate_from α).u_l_left_inverse

lemma generate_from_surjective :
  surjective (generate_from : set (set α) → topological_space α) :=
(gci_generate_from α).u_surjective

lemma set_of_is_open_injective : injective (λ t : topological_space α, {s | is_open[t] s}) :=
(gci_generate_from α).l_injective

end lattice

end topological_space

section lattice

variables {α : Type u} {β : Type v}

lemma is_open.mono {α} {t₁ t₂ : topological_space α} {s : set α} (hs : is_open[t₂] s)
  (h : t₁ ≤ t₂) : is_open[t₁] s := h s hs

lemma is_closed.mono {α} {t₁ t₂ : topological_space α} {s : set α} (hs : is_closed[t₂] s)
  (h : t₁ ≤ t₂) : is_closed[t₁] s :=
(@is_open_compl_iff α t₁ s).mp $ hs.is_open_compl.mono h

lemma is_open_implies_is_open_iff {a b : topological_space α} :
  (∀ s, is_open[a] s → is_open[b] s) ↔ b ≤ a :=
iff.rfl

/-- The only open sets in the indiscrete topology are the empty set and the whole space. -/
lemma topological_space.is_open_top_iff {α} (U : set α) :
  is_open[⊤] U ↔ U = ∅ ∨ U = univ :=
⟨λ h, begin
  induction h with V h _ _ _ _ ih₁ ih₂ _ _ ih,
  { cases h }, { exact or.inr rfl },
  { obtain ⟨rfl|rfl, rfl|rfl⟩ := ⟨ih₁, ih₂⟩; simp },
  { rw [sUnion_eq_empty, or_iff_not_imp_left],
    intro h, push_neg at h, obtain ⟨U, hU, hne⟩ := h,
    have := (ih U hU).resolve_left hne, subst this,
    refine sUnion_eq_univ_iff.2 (λ a, ⟨_, hU, trivial⟩) },
end, by { rintro (rfl|rfl), exacts [@is_open_empty _ ⊤, @is_open_univ _ ⊤] }⟩

/-- A topological space is discrete if every set is open, that is,
  its topology equals the discrete topology `⊥`. -/
class discrete_topology (α : Type*) [t : topological_space α] : Prop :=
(eq_bot [] : t = ⊥)

lemma discrete_topology_bot (α : Type*) : @discrete_topology α ⊥ := @discrete_topology.mk α ⊥ rfl

@[simp] lemma is_open_discrete [topological_space α] [discrete_topology α] (s : set α) :
  is_open s :=
(discrete_topology.eq_bot α).symm ▸ trivial

@[simp] lemma is_closed_discrete [topological_space α] [discrete_topology α] (s : set α) :
  is_closed s :=
is_open_compl_iff.1 $ is_open_discrete _

@[nontriviality]
lemma continuous_of_discrete_topology [topological_space α] [discrete_topology α]
  [topological_space β] {f : α → β} : continuous f :=
continuous_def.2 $ λ s hs, is_open_discrete _

@[simp] lemma nhds_discrete (α : Type*) [topological_space α] [discrete_topology α] :
  (@nhds α _) = pure :=
le_antisymm (λ _ s hs, (is_open_discrete s).mem_nhds hs) pure_le_nhds

lemma mem_nhds_discrete [topological_space α] [discrete_topology α] {x : α} {s : set α} :
  s ∈ 𝓝 x ↔ x ∈ s :=
by rw [nhds_discrete, mem_pure]

lemma le_of_nhds_le_nhds {t₁ t₂ : topological_space α} (h : ∀x, @nhds α t₁ x ≤ @nhds α t₂ x) :
  t₁ ≤ t₂ :=
begin
  intro s,
  rw [@is_open_iff_mem_nhds _ t₁, @is_open_iff_mem_nhds α t₂],
  exact λ hs a ha, h _ (hs _ ha)
end

lemma eq_of_nhds_eq_nhds {t₁ t₂ : topological_space α} (h : ∀x, @nhds α t₁ x = @nhds α t₂ x) :
  t₁ = t₂ :=
le_antisymm
  (le_of_nhds_le_nhds $ assume x, le_of_eq $ h x)
  (le_of_nhds_le_nhds $ assume x, le_of_eq $ (h x).symm)

lemma eq_bot_of_singletons_open {t : topological_space α} (h : ∀ x, is_open[t] {x}) : t = ⊥ :=
bot_unique $ λ s hs, bUnion_of_singleton s ▸ is_open_bUnion (λ x _, h x)

lemma forall_open_iff_discrete {X : Type*} [topological_space X] :
  (∀ s : set X, is_open s) ↔ discrete_topology X :=
⟨λ h, ⟨eq_bot_of_singletons_open $ λ _, h _⟩, @is_open_discrete _ _⟩

lemma singletons_open_iff_discrete {X : Type*} [topological_space X] :
  (∀ a : X, is_open ({a} : set X)) ↔ discrete_topology X :=
⟨λ h, ⟨eq_bot_of_singletons_open h⟩, λ a _, @is_open_discrete _ _ a _⟩

lemma discrete_topology_iff_singleton_mem_nhds [topological_space α] :
  discrete_topology α ↔ ∀ x : α, {x} ∈ 𝓝 x :=
by simp only [← singletons_open_iff_discrete, is_open_iff_mem_nhds, mem_singleton_iff, forall_eq]

/-- This lemma characterizes discrete topological spaces as those whose singletons are
neighbourhoods. -/
lemma discrete_topology_iff_nhds [topological_space α] :
  discrete_topology α ↔ ∀ x : α, 𝓝 x = pure x :=
by simp only [discrete_topology_iff_singleton_mem_nhds, ← nhds_ne_bot.le_pure_iff,
  le_pure_iff]

lemma discrete_topology_iff_nhds_ne [topological_space α] :
  discrete_topology α ↔ ∀ x : α, 𝓝[≠] x = ⊥ :=
by simp only [discrete_topology_iff_singleton_mem_nhds, nhds_within, inf_principal_eq_bot,
  compl_compl]

end lattice

section galois_connection
variables {α : Type*} {β : Type*} {γ : Type*}

/-- Given `f : α → β` and a topology on `β`, the induced topology on `α` is the collection of
  sets that are preimages of some open set in `β`. This is the coarsest topology that
  makes `f` continuous. -/
def topological_space.induced {α : Type u} {β : Type v} (f : α → β) (t : topological_space β) :
  topological_space α :=
{ is_open        := λs, ∃ s', is_open s' ∧ f ⁻¹' s' = s,
  is_open_univ   := ⟨univ, is_open_univ, preimage_univ⟩,
  is_open_inter  := by rintro s₁ s₂ ⟨s'₁, hs₁, rfl⟩ ⟨s'₂, hs₂, rfl⟩;
    exact ⟨s'₁ ∩ s'₂, hs₁.inter hs₂, preimage_inter⟩,
  is_open_sUnion := assume s h,
  begin
    simp only [classical.skolem] at h,
    cases h with f hf,
    apply exists.intro (⋃(x : set α) (h : x ∈ s), f x h),
    simp only [sUnion_eq_bUnion, preimage_Union, (λx h, (hf x h).right)], refine ⟨_, rfl⟩,
    exact (@is_open_Union β _ t _ $ assume i,
      show is_open (⋃h, f i h), from @is_open_Union β _ t _ $ assume h, (hf i h).left)
  end }

lemma is_open_induced_iff [t : topological_space β] {s : set α} {f : α → β} :
  is_open[t.induced f] s ↔ (∃t, is_open t ∧ f ⁻¹' t = s) :=
iff.rfl

lemma is_closed_induced_iff [t : topological_space β] {s : set α} {f : α → β} :
  is_closed[t.induced f] s ↔ (∃t, is_closed t ∧ f ⁻¹' t = s) :=
begin
  simp only [← is_open_compl_iff, is_open_induced_iff],
  exact compl_surjective.exists.trans (by simp only [preimage_compl, compl_inj_iff])
end

/-- Given `f : α → β` and a topology on `α`, the coinduced topology on `β` is defined
  such that `s:set β` is open if the preimage of `s` is open. This is the finest topology that
  makes `f` continuous. -/
def topological_space.coinduced {α : Type u} {β : Type v} (f : α → β) (t : topological_space α) :
  topological_space β :=
{ is_open        := λ s, is_open[t] (f ⁻¹' s),
  is_open_univ   := t.is_open_univ,
  is_open_inter  := λ _ _ h₁ h₂, h₁.inter h₂,
  is_open_sUnion := λ s h, by simpa only [preimage_sUnion] using is_open_bUnion h }

lemma is_open_coinduced {t : topological_space α} {s : set β} {f : α → β} :
  is_open[t.coinduced f] s ↔ is_open (f ⁻¹' s) :=
iff.rfl

lemma preimage_nhds_coinduced [topological_space α] {π : α → β} {s : set β}
  {a : α} (hs : s ∈ @nhds β (topological_space.coinduced π ‹_›) (π a)) : π ⁻¹' s ∈ 𝓝 a :=
begin
  letI := topological_space.coinduced π ‹_›,
  rcases mem_nhds_iff.mp hs with ⟨V, hVs, V_op, mem_V⟩,
  exact mem_nhds_iff.mpr ⟨π ⁻¹' V, set.preimage_mono hVs, V_op, mem_V⟩
end

variables {t t₁ t₂ : topological_space α} {t' : topological_space β} {f : α → β} {g : β → α}

lemma continuous.coinduced_le (h : @continuous α β t t' f) :
  t.coinduced f ≤ t' :=
λ s hs, (continuous_def.1 h s hs : _)

lemma coinduced_le_iff_le_induced {f : α → β} {tα : topological_space α}
  {tβ : topological_space β} :
  tα.coinduced f ≤ tβ ↔ tα ≤ tβ.induced f :=
⟨λ h s ⟨t, ht, hst⟩, hst ▸ h _ ht, λ h s hs, h _ ⟨s, hs, rfl⟩⟩

lemma continuous.le_induced (h : @continuous α β t t' f) :
  t ≤ t'.induced f :=
coinduced_le_iff_le_induced.1 h.coinduced_le

lemma gc_coinduced_induced (f : α → β) :
  galois_connection (topological_space.coinduced f) (topological_space.induced f) :=
assume f g, coinduced_le_iff_le_induced

lemma induced_mono (h : t₁ ≤ t₂) : t₁.induced g ≤ t₂.induced g :=
(gc_coinduced_induced g).monotone_u h

lemma coinduced_mono (h : t₁ ≤ t₂) : t₁.coinduced f ≤ t₂.coinduced f :=
(gc_coinduced_induced f).monotone_l h

@[simp] lemma induced_top : (⊤ : topological_space α).induced g = ⊤ :=
(gc_coinduced_induced g).u_top

@[simp] lemma induced_inf : (t₁ ⊓ t₂).induced g = t₁.induced g ⊓ t₂.induced g :=
(gc_coinduced_induced g).u_inf

@[simp] lemma induced_infi {ι : Sort w} {t : ι → topological_space α} :
  (⨅i, t i).induced g = (⨅i, (t i).induced g) :=
(gc_coinduced_induced g).u_infi

@[simp] lemma coinduced_bot : (⊥ : topological_space α).coinduced f = ⊥ :=
(gc_coinduced_induced f).l_bot

@[simp] lemma coinduced_sup : (t₁ ⊔ t₂).coinduced f = t₁.coinduced f ⊔ t₂.coinduced f :=
(gc_coinduced_induced f).l_sup

@[simp] lemma coinduced_supr {ι : Sort w} {t : ι → topological_space α} :
  (⨆i, t i).coinduced f = (⨆i, (t i).coinduced f) :=
(gc_coinduced_induced f).l_supr

lemma induced_id [t : topological_space α] : t.induced id = t :=
topological_space_eq $ funext $ assume s, propext $
  ⟨assume ⟨s', hs, h⟩, h ▸ hs, assume hs, ⟨s, hs, rfl⟩⟩

lemma induced_compose [tγ : topological_space γ]
  {f : α → β} {g : β → γ} : (tγ.induced g).induced f = tγ.induced (g ∘ f) :=
topological_space_eq $ funext $ assume s, propext $
  ⟨assume ⟨s', ⟨s, hs, h₂⟩, h₁⟩, h₁ ▸ h₂ ▸ ⟨s, hs, rfl⟩,
    assume ⟨s, hs, h⟩, ⟨preimage g s, ⟨s, hs, rfl⟩, h ▸ rfl⟩⟩

lemma induced_const [t : topological_space α] {x : α} :
  t.induced (λ y : β, x) = ⊤ :=
le_antisymm le_top (@continuous_const β α ⊤ t x).le_induced

lemma coinduced_id [t : topological_space α] : t.coinduced id = t :=
topological_space_eq rfl

lemma coinduced_compose [tα : topological_space α]
  {f : α → β} {g : β → γ} : (tα.coinduced f).coinduced g = tα.coinduced (g ∘ f) :=
topological_space_eq rfl

lemma equiv.induced_symm {α β : Type*} (e : α ≃ β) :
  topological_space.induced e.symm = topological_space.coinduced e :=
begin
  ext t U,
  split,
  { rintros ⟨V, hV, rfl⟩,
    rwa [is_open_coinduced, e.preimage_symm_preimage] },
  { exact λ hU, ⟨e ⁻¹' U, hU, e.symm_preimage_preimage _⟩ }
end

lemma equiv.coinduced_symm {α β : Type*} (e : α ≃ β) :
  topological_space.coinduced e.symm = topological_space.induced e :=
by rw [← e.symm.induced_symm, e.symm_symm]

end galois_connection

/- constructions using the complete lattice structure -/
section constructions
open topological_space

variables {α : Type u} {β : Type v}

instance inhabited_topological_space {α : Type u} : inhabited (topological_space α) :=
⟨⊥⟩

@[priority 100]
instance subsingleton.unique_topological_space [subsingleton α] :
  unique (topological_space α) :=
{ default := ⊥,
  uniq := λ t, eq_bot_of_singletons_open $ λ x, subsingleton.set_cases
    (@is_open_empty _ t) (@is_open_univ _ t) ({x} : set α) }

@[priority 100]
instance subsingleton.discrete_topology [t : topological_space α] [subsingleton α] :
  discrete_topology α :=
⟨unique.eq_default t⟩

instance : topological_space empty := ⊥
instance : discrete_topology empty := ⟨rfl⟩
instance : topological_space pempty := ⊥
instance : discrete_topology pempty := ⟨rfl⟩
instance : topological_space punit := ⊥
instance : discrete_topology punit := ⟨rfl⟩
instance : topological_space bool := ⊥
instance : discrete_topology bool := ⟨rfl⟩
instance : topological_space ℕ := ⊥
instance : discrete_topology ℕ := ⟨rfl⟩
instance : topological_space ℤ := ⊥
instance : discrete_topology ℤ := ⟨rfl⟩

instance {n} : topological_space (fin n) := ⊥
instance {n} : discrete_topology (fin n) := ⟨rfl⟩

instance sierpinski_space : topological_space Prop :=
generate_from {{true}}

lemma continuous_empty_function [topological_space α] [topological_space β] [is_empty β]
  (f : α → β) : continuous f :=
by { letI := function.is_empty f, exact continuous_of_discrete_topology }

lemma le_generate_from {t : topological_space α} { g : set (set α) } (h : ∀s∈g, is_open s) :
  t ≤ generate_from g :=
le_generate_from_iff_subset_is_open.2 h

lemma induced_generate_from_eq {α β} {b : set (set β)} {f : α → β} :
  (generate_from b).induced f = topological_space.generate_from (preimage f '' b) :=
le_antisymm
  (le_generate_from $ ball_image_iff.2 $ assume s hs, ⟨s, generate_open.basic _ hs, rfl⟩)
  (coinduced_le_iff_le_induced.1 $ le_generate_from $ assume s hs,
    generate_open.basic _ $ mem_image_of_mem _ hs)

lemma le_induced_generate_from {α β} [t : topological_space α] {b : set (set β)}
  {f : α → β} (h : ∀ (a : set β), a ∈ b → is_open (f ⁻¹' a)) : t ≤ induced f (generate_from b) :=
begin
  rw induced_generate_from_eq,
  apply le_generate_from,
  simp only [mem_image, and_imp, forall_apply_eq_imp_iff₂, exists_imp_distrib],
  exact h,
end

/-- This construction is left adjoint to the operation sending a topology on `α`
  to its neighborhood filter at a fixed point `a : α`. -/
def nhds_adjoint (a : α) (f : filter α) : topological_space α :=
{ is_open        := λs, a ∈ s → s ∈ f,
  is_open_univ   := assume s, univ_mem,
  is_open_inter  := assume s t hs ht ⟨has, hat⟩, inter_mem (hs has) (ht hat),
  is_open_sUnion := assume k hk ⟨u, hu, hau⟩, mem_of_superset (hk u hu hau)
    (subset_sUnion_of_mem hu) }

lemma gc_nhds (a : α) :
  galois_connection (nhds_adjoint a) (λt, @nhds α t a) :=
assume f t, by { rw le_nhds_iff, exact ⟨λ H s hs has, H _ has hs, λ H s has hs, H _ hs has⟩ }

lemma nhds_mono {t₁ t₂ : topological_space α} {a : α} (h : t₁ ≤ t₂) :
  @nhds α t₁ a ≤ @nhds α t₂ a := (gc_nhds a).monotone_u h

lemma le_iff_nhds {α : Type*} (t t' : topological_space α) :
  t ≤ t' ↔ ∀ x, @nhds α t x ≤ @nhds α t' x :=
⟨λ h x, nhds_mono h, le_of_nhds_le_nhds⟩

lemma nhds_adjoint_nhds {α : Type*} (a : α) (f : filter α) :
  @nhds α (nhds_adjoint a f) a = pure a ⊔ f :=
begin
  ext U,
  rw mem_nhds_iff,
  split,
  { rintros ⟨t, htU, ht, hat⟩,
    exact ⟨htU hat, mem_of_superset (ht hat) htU⟩},
  { rintros ⟨haU, hU⟩,
    exact ⟨U, subset.rfl, λ h, hU, haU⟩ }
end

lemma nhds_adjoint_nhds_of_ne {α : Type*} (a : α) (f : filter α) {b : α} (h : b ≠ a) :
  @nhds α (nhds_adjoint a f) b = pure b :=
begin
  apply le_antisymm,
  { intros U hU,
    rw mem_nhds_iff,
    use {b},
    simp only [and_true, singleton_subset_iff, mem_singleton],
    refine ⟨hU, λ ha, (h.symm ha).elim⟩ },
  { exact @pure_le_nhds α (nhds_adjoint a f) b },
end

lemma is_open_singleton_nhds_adjoint {α : Type*} {a b : α} (f : filter α) (hb : b ≠ a) :
  is_open[nhds_adjoint a f] {b} :=
begin
  rw is_open_singleton_iff_nhds_eq_pure,
  exact nhds_adjoint_nhds_of_ne a f hb
end

lemma le_nhds_adjoint_iff' {α : Type*} (a : α) (f : filter α) (t : topological_space α) :
  t ≤ nhds_adjoint a f ↔ @nhds α t a ≤ pure a ⊔ f ∧ ∀ b ≠ a, @nhds α t b = pure b :=
begin
  rw le_iff_nhds,
  split,
  { intros h,
    split,
    { specialize h a,
      rwa nhds_adjoint_nhds at h },
    { intros b hb,
      apply le_antisymm _ (pure_le_nhds b),
      specialize h b,
      rwa nhds_adjoint_nhds_of_ne a f hb at h } },
  { rintros ⟨h, h'⟩ b,
    by_cases hb : b = a,
    { rwa [hb, nhds_adjoint_nhds] },
    { simp [nhds_adjoint_nhds_of_ne a f hb, h' b hb] } }
end

lemma le_nhds_adjoint_iff {α : Type*} (a : α) (f : filter α) (t : topological_space α) :
  t ≤ nhds_adjoint a f ↔ (@nhds α t a ≤ pure a ⊔ f ∧ ∀ b, b ≠ a → is_open[t] {b}) :=
begin
  change _ ↔ _ ∧ ∀ (b : α), b ≠ a → is_open {b},
  rw [le_nhds_adjoint_iff', and.congr_right_iff],
  apply λ h, forall_congr (λ b,  _),
  rw @is_open_singleton_iff_nhds_eq_pure α t b
end

lemma nhds_infi {ι : Sort*} {t : ι → topological_space α} {a : α} :
  @nhds α (infi t) a = (⨅i, @nhds α (t i) a) := (gc_nhds a).u_infi

lemma nhds_Inf {s : set (topological_space α)} {a : α} :
  @nhds α (Inf s) a = (⨅t∈s, @nhds α t a) := (gc_nhds a).u_Inf

lemma nhds_inf {t₁ t₂ : topological_space α} {a : α} :
  @nhds α (t₁ ⊓ t₂) a = @nhds α t₁ a ⊓ @nhds α t₂ a := (gc_nhds a).u_inf

lemma nhds_top {a : α} : @nhds α ⊤ a = ⊤ := (gc_nhds a).u_top

lemma is_open_sup {t₁ t₂ : topological_space α} {s : set α} :
  is_open[t₁ ⊔ t₂] s ↔ is_open[t₁] s ∧ is_open[t₂] s :=
iff.rfl

local notation `cont` := @continuous _ _
local notation `tspace` := topological_space
open topological_space

variables {γ : Type*} {f : α → β} {ι : Sort*}

lemma continuous_iff_coinduced_le {t₁ : tspace α} {t₂ : tspace β} :
  cont t₁ t₂ f ↔ coinduced f t₁ ≤ t₂ :=
continuous_def.trans iff.rfl

lemma continuous_iff_le_induced {t₁ : tspace α} {t₂ : tspace β} :
  cont t₁ t₂ f ↔ t₁ ≤ induced f t₂ :=
iff.trans continuous_iff_coinduced_le (gc_coinduced_induced f _ _)

theorem continuous_generated_from {t : tspace α} {b : set (set β)}
  (h : ∀s∈b, is_open (f ⁻¹' s)) : cont t (generate_from b) f :=
continuous_iff_coinduced_le.2 $ le_generate_from h

@[continuity]
lemma continuous_induced_dom {t : tspace β} : cont (induced f t) t f :=
by { rw continuous_def, assume s h, exact ⟨_, h, rfl⟩ }

lemma continuous_induced_rng {g : γ → α} {t₂ : tspace β} {t₁ : tspace γ} :
  cont t₁ (induced f t₂) g ↔ cont t₁ t₂ (f ∘ g) :=
by simp only [continuous_iff_le_induced, induced_compose]

lemma continuous_coinduced_rng {t : tspace α} : cont t (coinduced f t) f :=
by { rw continuous_def, assume s h, exact h }

lemma continuous_coinduced_dom {g : β → γ} {t₁ : tspace α} {t₂ : tspace γ} :
  cont (coinduced f t₁) t₂ g ↔ cont t₁ t₂ (g ∘ f) :=
by simp only [continuous_iff_coinduced_le, coinduced_compose]

lemma continuous_le_dom {t₁ t₂ : tspace α} {t₃ : tspace β}
  (h₁ : t₂ ≤ t₁) (h₂ : cont t₁ t₃ f) : cont t₂ t₃ f :=
begin
  rw continuous_def at h₂ ⊢,
  assume s h,
  exact h₁ _ (h₂ s h)
end

lemma continuous_le_rng {t₁ : tspace α} {t₂ t₃ : tspace β}
  (h₁ : t₂ ≤ t₃) (h₂ : cont t₁ t₂ f) : cont t₁ t₃ f :=
begin
  rw continuous_def at h₂ ⊢,
  assume s h,
  exact h₂ s (h₁ s h)
end

lemma continuous_sup_dom {t₁ t₂ : tspace α} {t₃ : tspace β} :
  cont (t₁ ⊔ t₂) t₃ f ↔ cont t₁ t₃ f ∧ cont t₂ t₃ f :=
by simp only [continuous_iff_le_induced, sup_le_iff]

lemma continuous_sup_rng_left {t₁ : tspace α} {t₃ t₂ : tspace β} :
  cont t₁ t₂ f → cont t₁ (t₂ ⊔ t₃) f :=
continuous_le_rng le_sup_left

lemma continuous_sup_rng_right {t₁ : tspace α} {t₃ t₂ : tspace β} :
  cont t₁ t₃ f → cont t₁ (t₂ ⊔ t₃) f :=
continuous_le_rng le_sup_right

lemma continuous_Sup_dom {T : set (tspace α)} {t₂ : tspace β} :
  cont (Sup T) t₂ f ↔ ∀ t ∈ T, cont t t₂ f :=
by simp only [continuous_iff_le_induced, Sup_le_iff]

lemma continuous_Sup_rng {t₁ : tspace α} {t₂ : set (tspace β)} {t : tspace β}
  (h₁ : t ∈ t₂) (hf : cont t₁ t f) : cont t₁ (Sup t₂) f :=
continuous_iff_coinduced_le.2 $ le_Sup_of_le h₁ $ continuous_iff_coinduced_le.1 hf

lemma continuous_supr_dom {t₁ : ι → tspace α} {t₂ : tspace β} :
  cont (supr t₁) t₂ f ↔  ∀ i, cont (t₁ i) t₂ f :=
by simp only [continuous_iff_le_induced, supr_le_iff]

lemma continuous_supr_rng {t₁ : tspace α} {t₂ : ι → tspace β} {i : ι}
  (h : cont t₁ (t₂ i) f) : cont t₁ (supr t₂) f :=
continuous_Sup_rng ⟨i, rfl⟩ h

lemma continuous_inf_rng {t₁ : tspace α} {t₂ t₃ : tspace β} :
  cont t₁ (t₂ ⊓ t₃) f ↔ cont t₁ t₂ f ∧ cont t₁ t₃ f :=
by simp only [continuous_iff_coinduced_le, le_inf_iff]

lemma continuous_inf_dom_left {t₁ t₂ : tspace α} {t₃ : tspace β} :
  cont t₁ t₃ f → cont (t₁ ⊓ t₂) t₃ f :=
continuous_le_dom inf_le_left

lemma continuous_inf_dom_right {t₁ t₂ : tspace α} {t₃ : tspace β} :
  cont t₂ t₃ f → cont (t₁ ⊓ t₂) t₃ f :=
continuous_le_dom inf_le_right

lemma continuous_Inf_dom {t₁ : set (tspace α)} {t₂ : tspace β} {t : tspace α} (h₁ : t ∈ t₁) :
  cont t t₂ f → cont (Inf t₁) t₂ f :=
continuous_le_dom $ Inf_le h₁

lemma continuous_Inf_rng {t₁ : tspace α} {T : set (tspace β)} :
  cont t₁ (Inf T) f ↔ ∀ t ∈ T, cont t₁ t f :=
by simp only [continuous_iff_coinduced_le, le_Inf_iff]

lemma continuous_infi_dom {t₁ : ι → tspace α} {t₂ : tspace β} {i : ι} :
  cont (t₁ i) t₂ f → cont (infi t₁) t₂ f :=
continuous_le_dom $ infi_le _ _

lemma continuous_infi_rng {t₁ : tspace α} {t₂ : ι → tspace β} :
  cont t₁ (infi t₂) f ↔ ∀ i, cont t₁ (t₂ i) f :=
by simp only [continuous_iff_coinduced_le, le_infi_iff]

@[continuity] lemma continuous_bot {t : tspace β} : cont ⊥ t f :=
continuous_iff_le_induced.2 $ bot_le

@[continuity] lemma continuous_top {t : tspace α} : cont t ⊤ f :=
continuous_iff_coinduced_le.2 $ le_top

lemma continuous_id_iff_le {t t' : tspace α} : cont t t' id ↔ t ≤ t' :=
@continuous_def _ _ t t' id

lemma continuous_id_of_le {t t' : tspace α} (h : t ≤ t') : cont t t' id :=
continuous_id_iff_le.2 h

/- 𝓝 in the induced topology -/

theorem mem_nhds_induced [T : topological_space α] (f : β → α) (a : β) (s : set β) :
  s ∈ @nhds β (topological_space.induced f T) a ↔ ∃ u ∈ 𝓝 (f a), f ⁻¹' u ⊆ s :=
begin
  simp only [mem_nhds_iff, is_open_induced_iff, exists_prop, set.mem_set_of_eq],
  split,
  { rintros ⟨u, usub, ⟨v, openv, ueq⟩, au⟩,
    exact ⟨v, ⟨v, set.subset.refl v, openv, by rwa ←ueq at au⟩, by rw ueq; exact usub⟩ },
  rintros ⟨u, ⟨v, vsubu, openv, amem⟩, finvsub⟩,
  exact ⟨f ⁻¹' v, set.subset.trans (set.preimage_mono vsubu) finvsub, ⟨⟨v, openv, rfl⟩, amem⟩⟩
end

theorem nhds_induced [T : topological_space α] (f : β → α) (a : β) :
  @nhds β (topological_space.induced f T) a = comap f (𝓝 (f a)) :=
by { ext s, rw [mem_nhds_induced, mem_comap] }

lemma induced_iff_nhds_eq [tα : topological_space α] [tβ : topological_space β] (f : β → α) :
tβ = tα.induced f ↔ ∀ b, 𝓝 b = comap f (𝓝 $ f b) :=
⟨λ h a, h.symm ▸ nhds_induced f a, λ h, eq_of_nhds_eq_nhds $ λ x, by rw [h, nhds_induced]⟩

theorem map_nhds_induced_of_surjective [T : topological_space α]
    {f : β → α} (hf : surjective f) (a : β) :
  map f (@nhds β (topological_space.induced f T) a) = 𝓝 (f a) :=
by rw [nhds_induced, map_comap_of_surjective hf]

end constructions

section induced
open topological_space
variables {α : Type*} {β : Type*}
variables [t : topological_space β] {f : α → β}

theorem is_open_induced_eq {s : set α} :
  is_open[induced f t] s ↔ s ∈ preimage f '' {s | is_open s} :=
iff.rfl

theorem is_open_induced {s : set β} (h : is_open s) : is_open[induced f t] (f ⁻¹' s) :=
⟨s, h, rfl⟩

lemma map_nhds_induced_eq (a : α) : map f (@nhds α (induced f t) a) = 𝓝[range f] (f a) :=
by rw [nhds_induced, filter.map_comap, nhds_within]

lemma map_nhds_induced_of_mem {a : α} (h : range f ∈ 𝓝 (f a)) :
  map f (@nhds α (induced f t) a) = 𝓝 (f a) :=
by rw [nhds_induced, filter.map_comap_of_mem h]

lemma closure_induced [t : topological_space β] {f : α → β} {a : α} {s : set α} :
  a ∈ @closure α (topological_space.induced f t) s ↔ f a ∈ closure (f '' s) :=
by simp only [mem_closure_iff_frequently, nhds_induced, frequently_comap, mem_image, and_comm]

lemma is_closed_induced_iff' [t : topological_space β] {f : α → β} {s : set α} :
  is_closed[t.induced f] s ↔ ∀ a, f a ∈ closure (f '' s) → a ∈ s :=
by simp only [← closure_subset_iff_is_closed, subset_def, closure_induced]

end induced

section sierpinski
variables {α : Type*} [topological_space α]

@[simp] lemma is_open_singleton_true : is_open ({true} : set Prop) :=
topological_space.generate_open.basic _ (mem_singleton _)

@[simp] lemma nhds_true : 𝓝 true = pure true :=
le_antisymm (le_pure_iff.2 $ is_open_singleton_true.mem_nhds $ mem_singleton _) (pure_le_nhds _)

@[simp] lemma nhds_false : 𝓝 false = ⊤ :=
topological_space.nhds_generate_from.trans $ by simp [@and.comm (_ ∈ _)]

lemma continuous_Prop {p : α → Prop} : continuous p ↔ is_open {x | p x} :=
⟨assume h : continuous p,
  have is_open (p ⁻¹' {true}),
    from is_open_singleton_true.preimage h,
  by simpa [preimage, eq_true_iff] using this,
  assume h : is_open {x | p x},
  continuous_generated_from $ assume s (hs : s = {true}),
    by simp [hs, preimage, eq_true_iff, h]⟩

lemma is_open_iff_continuous_mem {s : set α} : is_open s ↔ continuous (λ x, x ∈ s) :=
continuous_Prop.symm

end sierpinski

section infi
variables {α : Type u} {ι : Sort v}

lemma generate_from_union (a₁ a₂ : set (set α)) :
  topological_space.generate_from (a₁ ∪ a₂) =
    topological_space.generate_from a₁ ⊓ topological_space.generate_from a₂ :=
(topological_space.gc_generate_from α).u_inf

lemma set_of_is_open_sup (t₁ t₂ : topological_space α) :
  {s | is_open[t₁ ⊔ t₂] s} = {s | is_open[t₁] s} ∩ {s | is_open[t₂] s} :=
rfl

lemma generate_from_Union {f : ι → set (set α)} :
  topological_space.generate_from (⋃ i, f i) = (⨅ i, topological_space.generate_from (f i)) :=
(topological_space.gc_generate_from α).u_infi

lemma set_of_is_open_supr {t : ι → topological_space α} :
  {s | is_open[⨆ i, t i] s} = ⋂ i, {s | is_open[t i] s} :=
(topological_space.gc_generate_from α).l_supr

lemma generate_from_sUnion {S : set (set (set α))} :
  topological_space.generate_from (⋃₀ S) = (⨅ s ∈ S, topological_space.generate_from s) :=
(topological_space.gc_generate_from α).u_Inf

lemma set_of_is_open_Sup {T : set (topological_space α)} :
  {s | is_open[Sup T] s} = ⋂ t ∈ T, {s | is_open[t] s} :=
(topological_space.gc_generate_from α).l_Sup

lemma generate_from_union_is_open (a b : topological_space α) :
  topological_space.generate_from ({s | is_open[a] s} ∪ {s | is_open[b] s}) = a ⊓ b :=
(topological_space.gci_generate_from α).u_inf_l a b

lemma generate_from_Union_is_open (f : ι → topological_space α) :
  topological_space.generate_from (⋃ i, {s | is_open[f i] s}) = ⨅ i, (f i) :=
(topological_space.gci_generate_from α).u_infi_l f

lemma generate_from_inter (a b : topological_space α) :
  topological_space.generate_from ({s | is_open[a] s} ∩ {s | is_open[b] s}) = a ⊔ b :=
(topological_space.gci_generate_from α).u_sup_l a b

lemma generate_from_Inter (f : ι → topological_space α) :
  topological_space.generate_from (⋂ i, {s | is_open[f i] s}) = ⨆ i, (f i) :=
(topological_space.gci_generate_from α).u_supr_l f

lemma generate_from_Inter_of_generate_from_eq_self (f : ι → set (set α))
  (hf : ∀ i, {s | is_open[topological_space.generate_from (f i)] s} = f i) :
  topological_space.generate_from (⋂ i, (f i)) = ⨆ i, topological_space.generate_from (f i) :=
(topological_space.gci_generate_from α).u_supr_of_lu_eq_self f hf

variables {t : ι → topological_space α}

lemma is_open_supr_iff {s : set α} : is_open[⨆ i, t i] s ↔ ∀ i, is_open[t i] s :=
show s ∈ set_of (is_open[supr t]) ↔ s ∈ {x : set α | ∀ (i : ι), is_open[t i] x},
by simp [set_of_is_open_supr]

lemma is_closed_supr_iff {s : set α} : is_closed[⨆ i, t i] s ↔ ∀ i, is_closed[t i] s :=
by simp [← is_open_compl_iff, is_open_supr_iff]

end infi


import Mathlib
import Mathlib.Tactic.Basic
import LeanCodePrompts.CheckParse
import LeanCodePrompts.ThmInfo
universe u v u_1 u_2

/-- Every Nat.Prime that is `1` greater than a multiple of `4` can be expressed as the sum of two squares. -/
theorem fermat_two_square0 : (∀ {p : ℕ}, p % 4 = 1 → Nat.Prime p → ∃ a b, a ^ 2 + b ^ 2 = p) → (∀ p : ℕ, Nat.Prime p → (p % 4 = 1) → ∃ a b : ℕ, a ^ 2 + b ^ 2 = p) := by
  intros h
  intros
  apply h <;> assumption

theorem fermat_two_square1 : (∀ p : ℕ, Nat.Prime p → (p % 4 = 1) → ∃ a b : ℕ, a ^ 2 + b ^ 2 = p) → (∀ {p : ℕ}, p % 4 = 1 → Nat.Prime p → ∃ a b, a ^ 2 + b ^ 2 = p) := by
  intro h
  intros
  apply h <;> assumption

/-- The product of two numbers, each of which is the sum of four squares, is itself a sum of four squares. -/
theorem euler_four_square_identity0 : (∀ {a b : ℤ},   ∃ x y z w,     a = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2 ∧ ∃ x y z w, b = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2 →       ∃ x y z w, (a * b) = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2) → (let is_sum_of_four_squares : ℕ → Prop := λ n : ℕ => ∃ (a b c d : ℕ), n = a^2 + b^2 + c^2 + d^2;
  ∀ (x y : ℕ), is_sum_of_four_squares x → is_sum_of_four_squares y → is_sum_of_four_squares (x * y)) := sorry
theorem euler_four_square_identity1 : (let is_sum_of_four_squares : ℕ → Prop := λ n : ℕ => ∃ (a b c d : ℕ), n = a^2 + b^2 + c^2 + d^2;
  ∀ (x y : ℕ), is_sum_of_four_squares x → is_sum_of_four_squares y → is_sum_of_four_squares (x * y)) → (∀ {a b : ℤ},   ∃ x y z w,     a = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2 ∧ b = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2 →       ∃ x y z w, (a * b) = x ^ 2 + y ^ 2 + z ^ 2 + w ^ 2) := sorry

/-- A ring with all elements idempotent is commutative. -/
example : ({R : Type u} → [inst : CommRing R] → (∀ (x : R), (x * x) = x) → CommRing R) → ({R : Type u} →  [Ring R] →  (∀ x : R, (x * x) = x) → CommRing R) := by
  intro h R RRing hyp
  -- the typeclasses seem to be causing issues
  haveI : CommRing R := sorry
  apply h
  intro x
  sorry -- apply hyp

example : ({R : Type u} →  [Ring R] →  (∀ x : R, (x * x) = 1)) → ({R : Type u} → [inst : CommRing R] → (∀ (x : R), (x * x) = x) → CommRing R) := sorry

/-- There are infinitely many pairs of Nat.Primes that differ exactly by `2`. -/
example : (∀ (n : ℕ), ∃ p₁ p₂, Nat.Prime p₁ ∧ Nat.Prime p₂ ∧ p₁ + 2 = p₂ ∧ (2 + n) < p₂) → (∀ n : ℕ, ∃ p : ℕ, p > n ∧ Nat.Prime p ∧ Nat.Prime (p + 2)) := by
  intro h n
  let ⟨p₁, p₂, Prime_p₁, Prime_p₂, hyp₁, hyp₂⟩ := h n
  use p₁
  apply And.intro -- `split` does not appear to exist yet
  sorry -- needs `linarith` or `norm_num`
  apply And.intro
  exact Prime_p₁
  rw [hyp₁]
  exact Prime_p₂

example : (∀ n : ℕ, ∃ p : ℕ, p > n ∧ Nat.Prime p ∧ Nat.Prime (p + 2)) → (∀ (n : ℕ), ∃ p₁ p₂, Nat.Prime p₁ ∧ Nat.Prime p₂ ∧ p₁ + 2 = p₂ ∧ 2 + n < p₂) := by
  intro h n
  let ⟨p, hpn, Prime_p, Prime_pp2⟩ := h n
  use p
  use p + 2
  have : (2 + n) < p + 2 := sorry -- linarith
  exact ⟨Prime_p, Prime_pp2, rfl, this⟩

/-- Every non-empty poset in which every chain has an upper bound contains a maximal element. -/
example : (∀ {α : Type u_1} {r : α → α → Prop} [inst : Preorder α],   (∀ (c : Set α) (a : IsChain r c), ∃ ub, ∀ (a : α), a ∈ c → r a ub) →     ∀ [inst : Nonempty α], ∃ m, ∀ (a : α), r m a → r a m) → ({α : Type u} → [PartialOrder α] →  [Nonempty α] →  (∀ c : Set α, IsChain LE.le c → (∃ b : α, ∀ a ∈ c, a ≤ b)) → (∃ m : α, ∀ a : α, m ≤ a → a = m)) := sorry
example : ({α : Type u} → [PartialOrder α] →  [Nonempty α] →  (∀ c : Set α, IsChain LE.le c → (∃ b : α, ∀ a ∈ c, a ≤ b)) → (∃ m : α, ∀ a : α, m ≤ a → a = m)) → (∀ {α : Type u_1} {r : α → α → Prop} [inst : Preorder α],   (∀ (c : Set α) (a : IsChain r c), ∃ ub, ∀ (a : α), a ∈ c → r a ub) →     ∀ [inst : Nonempty α], ∃ m, ∀ (a : α), r m a → r a m) := sorry

/-- A uniformly continuous function of a uniformly continuous function is uniformly continuous. -/
example : (∀ {α : Type u_1} {β : Type u_2} {γ : Type u_3} [inst : UniformSpace α] [inst_1 : UniformSpace β]   [inst_2 : UniformSpace γ] {f : α → β} {g : β → γ},   UniformContinuous f → UniformContinuous g → UniformContinuous (g ∘ f)) → ({α β γ : Type u} →  [UniformSpace α] →  [UniformSpace β] → [UniformSpace γ] →  (f : α → β) →  (g : β → γ) →  UniformContinuous f → UniformContinuous g → UniformContinuous (g ∘ f)) := sorry
example : ({α β γ : Type u} →  [UniformSpace α] →  [UniformSpace β] → [UniformSpace γ] →  (f : α → β) →  (g : β → γ) →  UniformContinuous f → UniformContinuous g → UniformContinuous (g ∘ f)) → (∀ {α : Type u_1} {β : Type u_2} {γ : Type u_3} [inst : UniformSpace α] [inst_1 : UniformSpace β]   [inst_2 : UniformSpace γ] {f : α → β} {g : β → γ},   UniformContinuous f → UniformContinuous g → UniformContinuous (g ∘ f)) := sorry

/-- A terminal object in a category is unique up to unique isomorphism. -/
example : (∀ {C : Type u₁} [inst : CategoryTheory.Category C] [inst_1 : CategoryTheory.Limits.HasTerminal C] {T T' : C}   (t : CategoryTheory.Limits.IsTerminal T),   CategoryTheory.Limits.IsTerminal T' → CategoryTheory.IsIso (CategoryTheory.Limits.IsTerminal.from t T')) → ({C : Type _} →  [CategoryTheory.Category C] →  ∀ T₁ T₂ : C, CategoryTheory.Limits.IsTerminal T₁ → CategoryTheory.Limits.IsTerminal T₂ → (∃ ι : CategoryTheory.Iso T₁ T₂, ∀ ι' : CategoryTheory.Iso T₁ T₂, ι = ι')) := sorry
example : ({C : Type _} →  [CategoryTheory.Category C] →  ∀ T₁ T₂ : C, CategoryTheory.Limits.IsTerminal T₁ → CategoryTheory.Limits.IsTerminal T₂ → (∃ ι : CategoryTheory.Iso T₁ T₂, ∀ ι' : CategoryTheory.Iso T₁ T₂, ι = ι')) → (∀ {C : Type u₁} [inst : CategoryTheory.Category C] [inst_1 : CategoryTheory.Limits.HasTerminal C] {T T' : C}   (t : CategoryTheory.Limits.IsTerminal T),   CategoryTheory.Limits.IsTerminal T' → CategoryTheory.IsIso (CategoryTheory.Limits.IsTerminal.from t T')) := sorry

/-- The sum of the cubes of two positive integers is never equal to the cube of a third integer. -/
example : (∀ (a b c : ℤ), a ^ 3 + b ^ 3 ≠ c ^ 3) → (∀ a b c : ℕ, a > 0 → b > 0 → ¬(a^3 + b^3 = c^3)) := sorry
example : (∀ a b c : ℕ, a > 0 → b > 0 → ¬(a^3 + b^3 = c^3)) → (∀ (a b c : ℤ), a ^ 3 + b ^ 3 ≠ c ^ 3) := sorry

/-- If every element of a group `G` has order `2`, then every pair of elements of `G` commutes. -/
example : (∀ {G : Type u_1} [inst : Group G], (∀ (x : G), x ^ 2 = 1) → ∀ {x y : G}, Commute x y) → ({G: Type u} → [Group G] →  (∀ x y : G, (x * x) = 1) → (∀ x y : G, Commute x y)) := sorry
example : ({G: Type u} → [Group G] →  (∀ x y : G, (x * x) = 1) → (∀ x y : G, Commute x y)) → (∀ {G : Type u_1} [inst : Group G], (∀ (x : G), x ^ 2 = 1) → ∀ {x y : G}, Commute x y) := sorry

/-- The product of two consecutive natural numbers is even. -/
example : (∀ {p q : ℕ}, p = q + 1 → Even (p * q)) → ((n: Nat) →  Even <| n * (n + 1)) := sorry
example : ((n: Nat) →  Even <| n * (n + 1)) → (∀ {p q : ℕ}, p = q + 1 → Even (p * q)) := sorry

/-- Every free group is torsion free. -/
example : (∀ (α : Type u), Monoid.IsTorsionFree (FreeGroup α)) → ({α : Type u} → Monoid.IsTorsionFree (FreeGroup α)) := sorry
example : ({α : Type u} → Monoid.IsTorsionFree (FreeGroup α)) → (∀ (α : Type u), Monoid.IsTorsionFree (FreeGroup α)) := sorry

/-- Every natural number greater than `1` is divisible by a Nat.Prime number.  -/
example : (∀ {n : ℕ}, 1 < n → ∃ p, Nat.Prime p ∧ p ∣ n) → ((n: ℕ) →
  n > 1 → ∃ p: ℕ, Nat.Prime p ∧ (∃ d: ℕ, (p * d) = n)) := sorry
example : ((n: ℕ) → n > 1 → ∃ p: ℕ, Nat.Prime p ∧ (∃ d: ℕ, (p * d) = n)) → (∀ {n : ℕ}, 1 < n → ∃ p, Nat.Prime p ∧ p ∣ n) := sorry

/-- A finite torsion-free group is trivial -/
example : (∀ {G : Type u} [inst : Group G] [inst_1 : Fintype G], Monoid.IsTorsionFree G → Fintype.card G = 1) → ({G: Type u} → [Group G] → [Finite G] → Monoid.IsTorsionFree G → IsSubgroup.Trivial G) := sorry
example : ({G: Type u} → [Group G] → [Finite G] → Monoid.IsTorsionFree G → IsSubgroup.Trivial G) → (∀ {G : Type u} [inst : Group G] [inst_1 : Fintype G], Monoid.IsTorsionFree G → Fintype.card G = 1) := sorry

/-- Every surjective homomorphism from a finitely generated free group to itself is injective -/
example : (∀ {α : Type u_1} {β : Type u_2} [inst : Group α] [inst_1 : Group β] [inst_2 : Fintype α] [inst_3 : Fintype β]   {f : α → β}, IsGroupHom f → Function.Surjective f → Function.Injective f) → ({α : Type u} →  [Finite α] → (f: FreeGroup α → FreeGroup α) → (IsGroupHom f) → f.Surjective → f.Injective) := sorry
example : ({α : Type u} →  [Finite α] → (f: FreeGroup α → FreeGroup α) → (IsGroupHom f) → f.Surjective → f.Injective) → (∀ {α : Type u_1} {β : Type u_2} [inst : Group α] [inst_1 : Group β] [inst_2 : Fintype α] [inst_3 : Fintype β]   {f : α → β}, IsGroupHom f → Function.Surjective f → Function.Injective f) := sorry

/-- Every positive even integer can be written as the sum of two Nat.Primes. -/
example : (∀ {n : ℕ}, 0 < n → Even n → ∃ p q, Nat.Prime p ∧ Nat.Prime q ∧ p + q = n) → (∀ n : ℕ, n > 0 → Even n → ∃ p q : ℕ, Nat.Prime p → Nat.Prime q → n = p + q) := sorry
example : (∀ n : ℕ, n > 0 → Even n → ∃ p q : ℕ, Nat.Prime p → Nat.Prime q → n = p + q) → (∀ {n : ℕ}, 0 < n → Even n → ∃ p q, Nat.Prime p ∧ Nat.Prime q ∧ p + q = n) := sorry

/-- If the square of a number is even, the number itself is even. -/
example : (∀ {M : Type u} [inst : Semiring M] [inst_1 : DecidableEq M] (a : M), Even (a * a) → Even a) → (∀ n : ℕ, Even (n^2) → Even n) := sorry
example : (∀ n : ℕ, Even (n^2) → Even n) → (∀ {M : Type u} [inst : Semiring M] [inst_1 : DecidableEq M] (a : M), Even (a * a) → Even a) := sorry

/-- If every point of a subset of a topological space is contained in some open set, the subset itself is open. -/
example : (∀ {α : Type u} [inst : TopologicalSpace α] {s : Set α}, (∀ (x : α), x ∈ s → ∃ t, IsOpen t ∧ x ∈ t) → IsOpen s) → ({X : Type u} →  [TopologicalSpace X] →  (S : Set X) →  (∀ x ∈ S, ∃ U : Set X, IsOpen U) → IsOpen S) := sorry
example : ({X : Type u} →  [TopologicalSpace X] →  (S : Set X) →  (∀ x ∈ S, ∃ U : Set X, IsOpen U) → IsOpen S) → (∀ {α : Type u} [inst : TopologicalSpace α] {s : Set α}, (∀ (x : α), x ∈ s → ∃ t, IsOpen t ∧ x ∈ t) → IsOpen s) := sorry

/-- Every non-identity element of a free group is of infinite order. -/
example : (∀ {α : Type u} [inst : DecidableEq α] {x : FreeGroup α}, x ≠ 1 → ¬IsOfFinOrder x) → ({G : Type u} →  [Group G] →  FreeGroup G → (∀ g : G, g ≠ 1 → orderOf g = 0)) := sorry
example : ({G : Type u} →  [Group G] →  FreeGroup G → (∀ g : G, g ≠ 1 → orderOf g = 0)) → (∀ {α : Type u} [inst : DecidableEq α] {x : FreeGroup α}, x ≠ 1 → ¬IsOfFinOrder x) := sorry

/-- For any two relatively Nat.Prime positive integers $a$ and $b$, every sufficiently large natural number $N$ can be written as a linear combination $ax + by$ of $a$ and $b$, where both $x$ and $y$ are natural numbers. -/
example : (∀ {m n : ℕ}, 0 < m → 0 < n → Nat.gcd m n = 1 → ∀ (N : ℕ), N > (m * n) → ∃ x y, N = (m * x) + (n * y)) → (∀ a b : ℕ, a > 0 → b > 0 → Nat.coprime a b → ∃ m : ℕ, ∀ N : ℕ, N > m → ∃ x y : ℕ, N = (a*x) + (b*y)) := sorry
example : (∀ a b : ℕ, a > 0 → b > 0 → Nat.coprime a b → ∃ m : ℕ, ∀ N : ℕ, N > m → ∃ x y : ℕ, N = (a*x) + (b*y)) → (∀ {m n : ℕ}, 0 < m → 0 < n → Nat.gcd m n = 1 → ∀ (N : ℕ), N > (m * n) → ∃ x y, N = (m * x) + (n * y)) := sorry

-- The ones below had no model answers

/-- The set of units in a ring forms a group. -/
example : ((R : Type u_1) → [inst : Ring R] → AddGroup (Units R)) → (Unit) := sorry
example : (Unit) → ((R : Type u_1) → [inst : Ring R] → AddGroup (Units R)) := sorry

/-- If the direct product of two groups is torsion free then each of the groups is torsion free. -/
example : (∀ {η : Type u_1} (G : Type u_2) [inst : Group G] {Γ : Type u_3} [inst_1 : Group Γ],   Monoid.IsTorsionFree (G × Γ) → Monoid.IsTorsionFree G ∧ Monoid.IsTorsionFree Γ) → (Unit) := sorry
example : (Unit) → (∀ {η : Type u_1} (G : Type u_2) [inst : Group G] {Γ : Type u_3} [inst_1 : Group Γ],   Monoid.IsTorsionFree (G × Γ) → Monoid.IsTorsionFree G ∧ Monoid.IsTorsionFree Γ) := sorry

-- #eval do
--   let l ← getFileThmInfo
--   --let l' := l.map Prod.fst |>.map Lean.Name.toString |>.qsort
--   -- return l'.groupBy $ λ s s' => s.dropRight 1 == s'.dropRight 1
--   return 1

-- #eval [1, 1, 2, 2].groupBy (· = ·)

-- #eval (Lean.Name.toString `fermat_two_square0).dropRight 1


import algebra.category.CommRing.basic
import algebra.ring
import tactic
import data.polynomial
import algebra.ring
import category_theory.types
import data.int.basic
universes v u
open CommRing
open is_ring_hom
open category_theory
open polynomial
open int
/--
## The goal is study the set of solution of polynomial equation in one variable ! We form a functor  V_P : CommRing → Type v
##    For all ring
##
-/

variables(R : Type v)[comm_ring R](P : polynomial ℤ)
structure V  (R: Type v)[comm_ring R] :=      --  set of solution of P(x) = 0  with x in R
(x : R)                                       --  if φ : R → R' is a ring morphism then we have application
(certif : eval₂(int.cast) (x) (P) = 0 )       --  φ : V(P)(R) → V(P(R')
@[ext]lemma ext : ∀ {ζ1 ζ2 : V P R}, ζ1.x = ζ2.x →  ζ1 = ζ2 := λ ζ1 ζ2,
begin
  cases ζ1,
  cases ζ2,
  intro h,
  congr ; try { assumption },
end
namespace commute_hom
lemma commute_hom  (P : polynomial ℤ)(R :Type v)[comm_ring R] (R' : Type v)[comm_ring R'] (f : R → R') [is_ring_hom f]
(x : R) : eval₂ int.cast (f x) P = f (eval₂ int.cast x P) := begin
    have H : eval₂ (f ∘ int.cast) (f x) P = f (eval₂ int.cast (x) P),
            rw ←  hom_eval₂  P  int.cast f x,
    have G : f ∘ int.cast = int.cast,
        exact (int.eq_cast') (f ∘ int.cast),
    rw G at H,assumption,
end

end commute_hom
definition map_V {R : Type v} [comm_ring R] {R' : Type v}[comm_ring R'] (f : R → R') [is_ring_hom f] : (V P R) → (V P R') := λ ζ,begin
exact  {x := f ζ.x, certif :=
begin
    have H : eval₂ (f ∘ int.cast) (f ζ.x) P = f (eval₂ int.cast (ζ.x) P),
        rw ←  hom_eval₂  P  int.cast f ζ.x,
    have G : f ∘ int.cast = int.cast,
        exact (int.eq_cast') (f ∘ int.cast),
    rw G at H,
    rw H,
    have cer : eval₂ int.cast ζ.x P =0,
        exact ζ.certif,
    rw cer,
    exact map_zero f,
    end}
end
lemma map_V_comp {R : Type v} [comm_ring R] {R' : Type v}[comm_ring R'] (f : R → R') [is_ring_hom f](ζ : V P R) : (map_V P f ζ).x = f ζ.x := rfl
def V_i : CommRing ⥤ Type v :=
{ obj := λ R, V P R,
  map := λ R R' f, map_V P  f,
  map_id' := λ R, begin
    apply funext,
    intro ζ,
    ext,
    rw types_id,
    rw map_V_comp,
    exact rfl,
   end,
  map_comp' := λ R R' R'' f g,
  begin
    apply funext,
    intro ζ,
    ext,
    rw map_V_comp,
    rw types_comp,
    rw map_V_comp,
    rw map_V_comp,
    exact rfl,
 end
}
def  F :=  (V_i P).obj
#print F


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Heather Macbeth

! This file was ported from Lean 3 source module analysis.inner_product_space.adjoint
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Dual
import Mathbin.Analysis.InnerProductSpace.PiL2

/-!
# Adjoint of operators on Hilbert spaces

Given an operator `A : E →L[𝕜] F`, where `E` and `F` are Hilbert spaces, its adjoint
`adjoint A : F →L[𝕜] E` is the unique operator such that `⟪x, A y⟫ = ⟪adjoint A x, y⟫` for all
`x` and `y`.

We then use this to put a C⋆-algebra structure on `E →L[𝕜] E` with the adjoint as the star
operation.

This construction is used to define an adjoint for linear maps (i.e. not continuous) between
finite dimensional spaces.

## Main definitions

* `continuous_linear_map.adjoint : (E →L[𝕜] F) ≃ₗᵢ⋆[𝕜] (F →L[𝕜] E)`: the adjoint of a continuous
  linear map, bundled as a conjugate-linear isometric equivalence.
* `linear_map.adjoint : (E →ₗ[𝕜] F) ≃ₗ⋆[𝕜] (F →ₗ[𝕜] E)`: the adjoint of a linear map between
  finite-dimensional spaces, this time only as a conjugate-linear equivalence, since there is no
  norm defined on these maps.

## Implementation notes

* The continuous conjugate-linear version `adjoint_aux` is only an intermediate
  definition and is not meant to be used outside this file.

## Tags

adjoint

-/

noncomputable section

open IsROrC

open ComplexConjugate

variable {𝕜 E F G : Type _} [IsROrC 𝕜]

variable [NormedAddCommGroup E] [NormedAddCommGroup F] [NormedAddCommGroup G]

variable [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] [InnerProductSpace 𝕜 G]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

/-! ### Adjoint operator -/

open InnerProductSpace

namespace ContinuousLinearMap

variable [CompleteSpace E] [CompleteSpace G]

/-- The adjoint, as a continuous conjugate-linear map.  This is only meant as an auxiliary
definition for the main definition `adjoint`, where this is bundled as a conjugate-linear isometric
equivalence. -/
def adjointAux : (E →L[𝕜] F) →L⋆[𝕜] F →L[𝕜] E :=
  (ContinuousLinearMap.compSL _ _ _ _ _ ((toDual 𝕜 E).symm : NormedSpace.Dual 𝕜 E →L⋆[𝕜] E)).comp
    (toSesqForm : (E →L[𝕜] F) →L[𝕜] F →L⋆[𝕜] NormedSpace.Dual 𝕜 E)
#align continuous_linear_map.adjoint_aux ContinuousLinearMap.adjointAux

@[simp]
theorem adjointAux_apply (A : E →L[𝕜] F) (x : F) :
    adjointAux A x = ((toDual 𝕜 E).symm : NormedSpace.Dual 𝕜 E → E) ((toSesqForm A) x) :=
  rfl
#align continuous_linear_map.adjoint_aux_apply ContinuousLinearMap.adjointAux_apply

theorem adjointAux_inner_left (A : E →L[𝕜] F) (x : E) (y : F) : ⟪adjointAux A y, x⟫ = ⟪y, A x⟫ := by
  simp only [adjoint_aux_apply, to_dual_symm_apply, to_sesq_form_apply_coe, coe_comp',
    innerSL_apply_coe]
#align continuous_linear_map.adjoint_aux_inner_left ContinuousLinearMap.adjointAux_inner_left

theorem adjointAux_inner_right (A : E →L[𝕜] F) (x : E) (y : F) : ⟪x, adjointAux A y⟫ = ⟪A x, y⟫ :=
  by rw [← inner_conj_symm, adjoint_aux_inner_left, inner_conj_symm]
#align continuous_linear_map.adjoint_aux_inner_right ContinuousLinearMap.adjointAux_inner_right

variable [CompleteSpace F]

theorem adjointAux_adjointAux (A : E →L[𝕜] F) : adjointAux (adjointAux A) = A :=
  by
  ext v
  refine' ext_inner_left 𝕜 fun w => _
  rw [adjoint_aux_inner_right, adjoint_aux_inner_left]
#align continuous_linear_map.adjoint_aux_adjoint_aux ContinuousLinearMap.adjointAux_adjointAux

@[simp]
theorem adjointAux_norm (A : E →L[𝕜] F) : ‖adjointAux A‖ = ‖A‖ :=
  by
  refine' le_antisymm _ _
  · refine' ContinuousLinearMap.op_norm_le_bound _ (norm_nonneg _) fun x => _
    rw [adjoint_aux_apply, LinearIsometryEquiv.norm_map]
    exact to_sesq_form_apply_norm_le
  · nth_rw_lhs 1 [← adjoint_aux_adjoint_aux A]
    refine' ContinuousLinearMap.op_norm_le_bound _ (norm_nonneg _) fun x => _
    rw [adjoint_aux_apply, LinearIsometryEquiv.norm_map]
    exact to_sesq_form_apply_norm_le
#align continuous_linear_map.adjoint_aux_norm ContinuousLinearMap.adjointAux_norm

/-- The adjoint of a bounded operator from Hilbert space E to Hilbert space F. -/
def adjoint : (E →L[𝕜] F) ≃ₗᵢ⋆[𝕜] F →L[𝕜] E :=
  LinearIsometryEquiv.ofSurjective { adjointAux with norm_map' := adjointAux_norm } fun A =>
    ⟨adjointAux A, adjointAux_adjointAux A⟩
#align continuous_linear_map.adjoint ContinuousLinearMap.adjoint

-- mathport name: adjoint
scoped[InnerProduct] postfix:1000 "†" => ContinuousLinearMap.adjoint

/-- The fundamental property of the adjoint. -/
theorem adjoint_inner_left (A : E →L[𝕜] F) (x : E) (y : F) : ⟪(A†) y, x⟫ = ⟪y, A x⟫ :=
  adjointAux_inner_left A x y
#align continuous_linear_map.adjoint_inner_left ContinuousLinearMap.adjoint_inner_left

/-- The fundamental property of the adjoint. -/
theorem adjoint_inner_right (A : E →L[𝕜] F) (x : E) (y : F) : ⟪x, (A†) y⟫ = ⟪A x, y⟫ :=
  adjointAux_inner_right A x y
#align continuous_linear_map.adjoint_inner_right ContinuousLinearMap.adjoint_inner_right

/-- The adjoint is involutive -/
@[simp]
theorem adjoint_adjoint (A : E →L[𝕜] F) : A†† = A :=
  adjointAux_adjointAux A
#align continuous_linear_map.adjoint_adjoint ContinuousLinearMap.adjoint_adjoint

/-- The adjoint of the composition of two operators is the composition of the two adjoints
in reverse order. -/
@[simp]
theorem adjoint_comp (A : F →L[𝕜] G) (B : E →L[𝕜] F) : (A ∘L B)† = B† ∘L A† :=
  by
  ext v
  refine' ext_inner_left 𝕜 fun w => _
  simp only [adjoint_inner_right, ContinuousLinearMap.coe_comp', Function.comp_apply]
#align continuous_linear_map.adjoint_comp ContinuousLinearMap.adjoint_comp

theorem apply_norm_sq_eq_inner_adjoint_left (A : E →L[𝕜] E) (x : E) :
    ‖A x‖ ^ 2 = re ⟪(A† * A) x, x⟫ :=
  by
  have h : ⟪(A† * A) x, x⟫ = ⟪A x, A x⟫ :=
    by
    rw [← adjoint_inner_left]
    rfl
  rw [h, ← inner_self_eq_norm_sq _]
#align continuous_linear_map.apply_norm_sq_eq_inner_adjoint_left ContinuousLinearMap.apply_norm_sq_eq_inner_adjoint_left

theorem apply_norm_eq_sqrt_inner_adjoint_left (A : E →L[𝕜] E) (x : E) :
    ‖A x‖ = Real.sqrt (re ⟪(A† * A) x, x⟫) := by
  rw [← apply_norm_sq_eq_inner_adjoint_left, Real.sqrt_sq (norm_nonneg _)]
#align continuous_linear_map.apply_norm_eq_sqrt_inner_adjoint_left ContinuousLinearMap.apply_norm_eq_sqrt_inner_adjoint_left

theorem apply_norm_sq_eq_inner_adjoint_right (A : E →L[𝕜] E) (x : E) :
    ‖A x‖ ^ 2 = re ⟪x, (A† * A) x⟫ :=
  by
  have h : ⟪x, (A† * A) x⟫ = ⟪A x, A x⟫ :=
    by
    rw [← adjoint_inner_right]
    rfl
  rw [h, ← inner_self_eq_norm_sq _]
#align continuous_linear_map.apply_norm_sq_eq_inner_adjoint_right ContinuousLinearMap.apply_norm_sq_eq_inner_adjoint_right

theorem apply_norm_eq_sqrt_inner_adjoint_right (A : E →L[𝕜] E) (x : E) :
    ‖A x‖ = Real.sqrt (re ⟪x, (A† * A) x⟫) := by
  rw [← apply_norm_sq_eq_inner_adjoint_right, Real.sqrt_sq (norm_nonneg _)]
#align continuous_linear_map.apply_norm_eq_sqrt_inner_adjoint_right ContinuousLinearMap.apply_norm_eq_sqrt_inner_adjoint_right

/-- The adjoint is unique: a map `A` is the adjoint of `B` iff it satisfies `⟪A x, y⟫ = ⟪x, B y⟫`
for all `x` and `y`. -/
theorem eq_adjoint_iff (A : E →L[𝕜] F) (B : F →L[𝕜] E) : A = B† ↔ ∀ x y, ⟪A x, y⟫ = ⟪x, B y⟫ :=
  by
  refine' ⟨fun h x y => by rw [h, adjoint_inner_left], fun h => _⟩
  ext x
  exact ext_inner_right 𝕜 fun y => by simp only [adjoint_inner_left, h x y]
#align continuous_linear_map.eq_adjoint_iff ContinuousLinearMap.eq_adjoint_iff

@[simp]
theorem adjoint_id : (ContinuousLinearMap.id 𝕜 E).adjoint = ContinuousLinearMap.id 𝕜 E :=
  by
  refine' Eq.symm _
  rw [eq_adjoint_iff]
  simp
#align continuous_linear_map.adjoint_id ContinuousLinearMap.adjoint_id

theorem Submodule.adjoint_subtypeL (U : Submodule 𝕜 E) [CompleteSpace U] :
    U.subtypeL† = orthogonalProjection U := by
  symm
  rw [eq_adjoint_iff]
  intro x u
  rw [U.coe_inner, inner_orthogonalProjection_left_eq_right,
    orthogonalProjection_mem_subspace_eq_self]
  rfl
#align submodule.adjoint_subtypeL Submodule.adjoint_subtypeL

theorem Submodule.adjoint_orthogonalProjection (U : Submodule 𝕜 E) [CompleteSpace U] :
    (orthogonalProjection U : E →L[𝕜] U)† = U.subtypeL := by
  rw [← U.adjoint_subtypeL, adjoint_adjoint]
#align submodule.adjoint_orthogonal_projection Submodule.adjoint_orthogonalProjection

/-- `E →L[𝕜] E` is a star algebra with the adjoint as the star operation. -/
instance : Star (E →L[𝕜] E) :=
  ⟨adjoint⟩

instance : InvolutiveStar (E →L[𝕜] E) :=
  ⟨adjoint_adjoint⟩

instance : StarSemigroup (E →L[𝕜] E) :=
  ⟨adjoint_comp⟩

instance : StarRing (E →L[𝕜] E) :=
  ⟨LinearIsometryEquiv.map_add adjoint⟩

instance : StarModule 𝕜 (E →L[𝕜] E) :=
  ⟨LinearIsometryEquiv.map_smulₛₗ adjoint⟩

theorem star_eq_adjoint (A : E →L[𝕜] E) : star A = A† :=
  rfl
#align continuous_linear_map.star_eq_adjoint ContinuousLinearMap.star_eq_adjoint

/-- A continuous linear operator is self-adjoint iff it is equal to its adjoint. -/
theorem isSelfAdjoint_iff' {A : E →L[𝕜] E} : IsSelfAdjoint A ↔ A.adjoint = A :=
  Iff.rfl
#align continuous_linear_map.is_self_adjoint_iff' ContinuousLinearMap.isSelfAdjoint_iff'

instance : CstarRing (E →L[𝕜] E) :=
  ⟨by
    intro A
    rw [star_eq_adjoint]
    refine' le_antisymm _ _
    ·
      calc
        ‖A† * A‖ ≤ ‖A†‖ * ‖A‖ := op_norm_comp_le _ _
        _ = ‖A‖ * ‖A‖ := by rw [LinearIsometryEquiv.norm_map]

    · rw [← sq, ← Real.sqrt_le_sqrt_iff (norm_nonneg _), Real.sqrt_sq (norm_nonneg _)]
      refine' op_norm_le_bound _ (Real.sqrt_nonneg _) fun x => _
      have :=
        calc
          re ⟪(A† * A) x, x⟫ ≤ ‖(A† * A) x‖ * ‖x‖ := re_inner_le_norm _ _
          _ ≤ ‖A† * A‖ * ‖x‖ * ‖x‖ := mul_le_mul_of_nonneg_right (le_op_norm _ _) (norm_nonneg _)

      calc
        ‖A x‖ = Real.sqrt (re ⟪(A† * A) x, x⟫) := by rw [apply_norm_eq_sqrt_inner_adjoint_left]
        _ ≤ Real.sqrt (‖A† * A‖ * ‖x‖ * ‖x‖) := (Real.sqrt_le_sqrt this)
        _ = Real.sqrt ‖A† * A‖ * ‖x‖ := by
          rw [mul_assoc, Real.sqrt_mul (norm_nonneg _), Real.sqrt_mul_self (norm_nonneg _)]
        ⟩

section Real

variable {E' : Type _} {F' : Type _}

variable [NormedAddCommGroup E'] [NormedAddCommGroup F']

variable [InnerProductSpace ℝ E'] [InnerProductSpace ℝ F']

variable [CompleteSpace E'] [CompleteSpace F']

-- Todo: Generalize this to `is_R_or_C`.
theorem isAdjointPair_inner (A : E' →L[ℝ] F') :
    LinearMap.IsAdjointPair (sesqFormOfInner : E' →ₗ[ℝ] E' →ₗ[ℝ] ℝ)
      (sesqFormOfInner : F' →ₗ[ℝ] F' →ₗ[ℝ] ℝ) A (A†) :=
  fun x y => by
  simp only [sesqFormOfInner_apply_apply, adjoint_inner_left, to_linear_map_eq_coe, coe_coe]
#align continuous_linear_map.is_adjoint_pair_inner ContinuousLinearMap.isAdjointPair_inner

end Real

end ContinuousLinearMap

/-! ### Self-adjoint operators -/

namespace IsSelfAdjoint

open ContinuousLinearMap

variable [CompleteSpace E] [CompleteSpace F]

theorem adjoint_eq {A : E →L[𝕜] E} (hA : IsSelfAdjoint A) : A.adjoint = A :=
  hA
#align is_self_adjoint.adjoint_eq IsSelfAdjoint.adjoint_eq

/-- Every self-adjoint operator on an inner product space is symmetric. -/
theorem isSymmetric {A : E →L[𝕜] E} (hA : IsSelfAdjoint A) : (A : E →ₗ[𝕜] E).IsSymmetric :=
  fun x y => by rw_mod_cast [← A.adjoint_inner_right, hA.adjoint_eq]
#align is_self_adjoint.is_symmetric IsSelfAdjoint.isSymmetric

/-- Conjugating preserves self-adjointness -/
theorem conj_adjoint {T : E →L[𝕜] E} (hT : IsSelfAdjoint T) (S : E →L[𝕜] F) :
    IsSelfAdjoint (S ∘L T ∘L S.adjoint) :=
  by
  rw [is_self_adjoint_iff'] at hT⊢
  simp only [hT, adjoint_comp, adjoint_adjoint]
  exact ContinuousLinearMap.comp_assoc _ _ _
#align is_self_adjoint.conj_adjoint IsSelfAdjoint.conj_adjoint

/-- Conjugating preserves self-adjointness -/
theorem adjoint_conj {T : E →L[𝕜] E} (hT : IsSelfAdjoint T) (S : F →L[𝕜] E) :
    IsSelfAdjoint (S.adjoint ∘L T ∘L S) :=
  by
  rw [is_self_adjoint_iff'] at hT⊢
  simp only [hT, adjoint_comp, adjoint_adjoint]
  exact ContinuousLinearMap.comp_assoc _ _ _
#align is_self_adjoint.adjoint_conj IsSelfAdjoint.adjoint_conj

theorem ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric {A : E →L[𝕜] E} :
    IsSelfAdjoint A ↔ (A : E →ₗ[𝕜] E).IsSymmetric :=
  ⟨fun hA => hA.IsSymmetric, fun hA =>
    ext fun x => ext_inner_right 𝕜 fun y => (A.adjoint_inner_left y x).symm ▸ (hA x y).symm⟩
#align continuous_linear_map.is_self_adjoint_iff_is_symmetric ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric

theorem LinearMap.IsSymmetric.isSelfAdjoint {A : E →L[𝕜] E} (hA : (A : E →ₗ[𝕜] E).IsSymmetric) :
    IsSelfAdjoint A := by rwa [← ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric] at hA
#align linear_map.is_symmetric.is_self_adjoint LinearMap.IsSymmetric.isSelfAdjoint

/-- The orthogonal projection is self-adjoint. -/
theorem orthogonalProjection_isSelfAdjoint (U : Submodule 𝕜 E) [CompleteSpace U] :
    IsSelfAdjoint (U.subtypeL ∘L orthogonalProjection U) :=
  (orthogonalProjection_isSymmetric U).IsSelfAdjoint
#align orthogonal_projection_is_self_adjoint orthogonalProjection_isSelfAdjoint

theorem conj_orthogonalProjection {T : E →L[𝕜] E} (hT : IsSelfAdjoint T) (U : Submodule 𝕜 E)
    [CompleteSpace U] :
    IsSelfAdjoint
      (U.subtypeL ∘L orthogonalProjection U ∘L T ∘L U.subtypeL ∘L orthogonalProjection U) :=
  by
  rw [← ContinuousLinearMap.comp_assoc]
  nth_rw 1 [← (orthogonalProjection_isSelfAdjoint U).adjoint_eq]
  refine' hT.adjoint_conj _
#align is_self_adjoint.conj_orthogonal_projection IsSelfAdjoint.conj_orthogonalProjection

end IsSelfAdjoint

namespace LinearMap

variable [CompleteSpace E]

variable {T : E →ₗ[𝕜] E}

/-- The **Hellinger--Toeplitz theorem**: Construct a self-adjoint operator from an everywhere
  defined symmetric operator.-/
def IsSymmetric.toSelfAdjoint (hT : IsSymmetric T) : selfAdjoint (E →L[𝕜] E) :=
  ⟨⟨T, hT.Continuous⟩, ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric.mpr hT⟩
#align linear_map.is_symmetric.to_self_adjoint LinearMap.IsSymmetric.toSelfAdjoint

theorem IsSymmetric.coe_toSelfAdjoint (hT : IsSymmetric T) : (hT.toSelfAdjoint : E →ₗ[𝕜] E) = T :=
  rfl
#align linear_map.is_symmetric.coe_to_self_adjoint LinearMap.IsSymmetric.coe_toSelfAdjoint

theorem IsSymmetric.toSelfAdjoint_apply (hT : IsSymmetric T) {x : E} : hT.toSelfAdjoint x = T x :=
  rfl
#align linear_map.is_symmetric.to_self_adjoint_apply LinearMap.IsSymmetric.toSelfAdjoint_apply

end LinearMap

namespace LinearMap

variable [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] [FiniteDimensional 𝕜 G]

attribute [local instance] FiniteDimensional.complete

/-- The adjoint of an operator from the finite-dimensional inner product space E to the finite-
dimensional inner product space F. -/
def adjoint : (E →ₗ[𝕜] F) ≃ₗ⋆[𝕜] F →ₗ[𝕜] E :=
  ((LinearMap.toContinuousLinearMap : (E →ₗ[𝕜] F) ≃ₗ[𝕜] E →L[𝕜] F).trans
        ContinuousLinearMap.adjoint.toLinearEquiv).trans
    LinearMap.toContinuousLinearMap.symm
#align linear_map.adjoint LinearMap.adjoint

theorem adjoint_toContinuousLinearMap (A : E →ₗ[𝕜] F) :
    A.adjoint.toContinuousLinearMap = A.toContinuousLinearMap.adjoint :=
  rfl
#align linear_map.adjoint_to_continuous_linear_map LinearMap.adjoint_toContinuousLinearMap

theorem adjoint_eq_to_clm_adjoint (A : E →ₗ[𝕜] F) : A.adjoint = A.toContinuousLinearMap.adjoint :=
  rfl
#align linear_map.adjoint_eq_to_clm_adjoint LinearMap.adjoint_eq_to_clm_adjoint

/-- The fundamental property of the adjoint. -/
theorem adjoint_inner_left (A : E →ₗ[𝕜] F) (x : E) (y : F) : ⟪adjoint A y, x⟫ = ⟪y, A x⟫ :=
  by
  rw [← coe_to_continuous_linear_map A, adjoint_eq_to_clm_adjoint]
  exact ContinuousLinearMap.adjoint_inner_left _ x y
#align linear_map.adjoint_inner_left LinearMap.adjoint_inner_left

/-- The fundamental property of the adjoint. -/
theorem adjoint_inner_right (A : E →ₗ[𝕜] F) (x : E) (y : F) : ⟪x, adjoint A y⟫ = ⟪A x, y⟫ :=
  by
  rw [← coe_to_continuous_linear_map A, adjoint_eq_to_clm_adjoint]
  exact ContinuousLinearMap.adjoint_inner_right _ x y
#align linear_map.adjoint_inner_right LinearMap.adjoint_inner_right

/-- The adjoint is involutive -/
@[simp]
theorem adjoint_adjoint (A : E →ₗ[𝕜] F) : A.adjoint.adjoint = A :=
  by
  ext v
  refine' ext_inner_left 𝕜 fun w => _
  rw [adjoint_inner_right, adjoint_inner_left]
#align linear_map.adjoint_adjoint LinearMap.adjoint_adjoint

/-- The adjoint of the composition of two operators is the composition of the two adjoints
in reverse order. -/
@[simp]
theorem adjoint_comp (A : F →ₗ[𝕜] G) (B : E →ₗ[𝕜] F) : (A ∘ₗ B).adjoint = B.adjoint ∘ₗ A.adjoint :=
  by
  ext v
  refine' ext_inner_left 𝕜 fun w => _
  simp only [adjoint_inner_right, LinearMap.coe_comp, Function.comp_apply]
#align linear_map.adjoint_comp LinearMap.adjoint_comp

/-- The adjoint is unique: a map `A` is the adjoint of `B` iff it satisfies `⟪A x, y⟫ = ⟪x, B y⟫`
for all `x` and `y`. -/
theorem eq_adjoint_iff (A : E →ₗ[𝕜] F) (B : F →ₗ[𝕜] E) :
    A = B.adjoint ↔ ∀ x y, ⟪A x, y⟫ = ⟪x, B y⟫ :=
  by
  refine' ⟨fun h x y => by rw [h, adjoint_inner_left], fun h => _⟩
  ext x
  exact ext_inner_right 𝕜 fun y => by simp only [adjoint_inner_left, h x y]
#align linear_map.eq_adjoint_iff LinearMap.eq_adjoint_iff

/-- The adjoint is unique: a map `A` is the adjoint of `B` iff it satisfies `⟪A x, y⟫ = ⟪x, B y⟫`
for all basis vectors `x` and `y`. -/
theorem eq_adjoint_iff_basis {ι₁ : Type _} {ι₂ : Type _} (b₁ : Basis ι₁ 𝕜 E) (b₂ : Basis ι₂ 𝕜 F)
    (A : E →ₗ[𝕜] F) (B : F →ₗ[𝕜] E) :
    A = B.adjoint ↔ ∀ (i₁ : ι₁) (i₂ : ι₂), ⟪A (b₁ i₁), b₂ i₂⟫ = ⟪b₁ i₁, B (b₂ i₂)⟫ :=
  by
  refine' ⟨fun h x y => by rw [h, adjoint_inner_left], fun h => _⟩
  refine' Basis.ext b₁ fun i₁ => _
  exact ext_inner_right_basis b₂ fun i₂ => by simp only [adjoint_inner_left, h i₁ i₂]
#align linear_map.eq_adjoint_iff_basis LinearMap.eq_adjoint_iff_basis

theorem eq_adjoint_iff_basis_left {ι : Type _} (b : Basis ι 𝕜 E) (A : E →ₗ[𝕜] F) (B : F →ₗ[𝕜] E) :
    A = B.adjoint ↔ ∀ i y, ⟪A (b i), y⟫ = ⟪b i, B y⟫ :=
  by
  refine' ⟨fun h x y => by rw [h, adjoint_inner_left], fun h => Basis.ext b fun i => _⟩
  exact ext_inner_right 𝕜 fun y => by simp only [h i, adjoint_inner_left]
#align linear_map.eq_adjoint_iff_basis_left LinearMap.eq_adjoint_iff_basis_left

theorem eq_adjoint_iff_basis_right {ι : Type _} (b : Basis ι 𝕜 F) (A : E →ₗ[𝕜] F) (B : F →ₗ[𝕜] E) :
    A = B.adjoint ↔ ∀ i x, ⟪A x, b i⟫ = ⟪x, B (b i)⟫ :=
  by
  refine' ⟨fun h x y => by rw [h, adjoint_inner_left], fun h => _⟩
  ext x
  refine' ext_inner_right_basis b fun i => by simp only [h i, adjoint_inner_left]
#align linear_map.eq_adjoint_iff_basis_right LinearMap.eq_adjoint_iff_basis_right

/-- `E →ₗ[𝕜] E` is a star algebra with the adjoint as the star operation. -/
instance : Star (E →ₗ[𝕜] E) :=
  ⟨adjoint⟩

instance : InvolutiveStar (E →ₗ[𝕜] E) :=
  ⟨adjoint_adjoint⟩

instance : StarSemigroup (E →ₗ[𝕜] E) :=
  ⟨adjoint_comp⟩

instance : StarRing (E →ₗ[𝕜] E) :=
  ⟨LinearEquiv.map_add adjoint⟩

instance : StarModule 𝕜 (E →ₗ[𝕜] E) :=
  ⟨LinearEquiv.map_smulₛₗ adjoint⟩

theorem star_eq_adjoint (A : E →ₗ[𝕜] E) : star A = A.adjoint :=
  rfl
#align linear_map.star_eq_adjoint LinearMap.star_eq_adjoint

/-- A continuous linear operator is self-adjoint iff it is equal to its adjoint. -/
theorem isSelfAdjoint_iff' {A : E →ₗ[𝕜] E} : IsSelfAdjoint A ↔ A.adjoint = A :=
  Iff.rfl
#align linear_map.is_self_adjoint_iff' LinearMap.isSelfAdjoint_iff'

theorem isSymmetric_iff_isSelfAdjoint (A : E →ₗ[𝕜] E) : IsSymmetric A ↔ IsSelfAdjoint A :=
  by
  rw [is_self_adjoint_iff', is_symmetric, ← LinearMap.eq_adjoint_iff]
  exact eq_comm
#align linear_map.is_symmetric_iff_is_self_adjoint LinearMap.isSymmetric_iff_isSelfAdjoint

section Real

variable {E' : Type _} {F' : Type _}

variable [NormedAddCommGroup E'] [NormedAddCommGroup F']

variable [InnerProductSpace ℝ E'] [InnerProductSpace ℝ F']

variable [FiniteDimensional ℝ E'] [FiniteDimensional ℝ F']

-- Todo: Generalize this to `is_R_or_C`.
theorem isAdjointPair_inner (A : E' →ₗ[ℝ] F') :
    IsAdjointPair (sesqFormOfInner : E' →ₗ[ℝ] E' →ₗ[ℝ] ℝ) (sesqFormOfInner : F' →ₗ[ℝ] F' →ₗ[ℝ] ℝ) A
      A.adjoint :=
  fun x y => by simp only [sesqFormOfInner_apply_apply, adjoint_inner_left]
#align linear_map.is_adjoint_pair_inner LinearMap.isAdjointPair_inner

end Real

/-- The Gram operator T†T is symmetric. -/
theorem isSymmetric_adjoint_mul_self (T : E →ₗ[𝕜] E) : IsSymmetric (T.adjoint * T) := fun x y => by
  simp only [mul_apply, adjoint_inner_left, adjoint_inner_right]
#align linear_map.is_symmetric_adjoint_mul_self LinearMap.isSymmetric_adjoint_mul_self

/-- The Gram operator T†T is a positive operator. -/
theorem re_inner_adjoint_mul_self_nonneg (T : E →ₗ[𝕜] E) (x : E) : 0 ≤ re ⟪x, (T.adjoint * T) x⟫ :=
  by
  simp only [mul_apply, adjoint_inner_right, inner_self_eq_norm_sq_to_K]
  norm_cast
  exact sq_nonneg _
#align linear_map.re_inner_adjoint_mul_self_nonneg LinearMap.re_inner_adjoint_mul_self_nonneg

@[simp]
theorem im_inner_adjoint_mul_self_eq_zero (T : E →ₗ[𝕜] E) (x : E) :
    im ⟪x, LinearMap.adjoint T (T x)⟫ = 0 :=
  by
  simp only [mul_apply, adjoint_inner_right, inner_self_eq_norm_sq_to_K]
  norm_cast
#align linear_map.im_inner_adjoint_mul_self_eq_zero LinearMap.im_inner_adjoint_mul_self_eq_zero

end LinearMap

namespace Matrix

variable {m n : Type _} [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n]

open ComplexConjugate

/-- The adjoint of the linear map associated to a matrix is the linear map associated to the
conjugate transpose of that matrix. -/
theorem toEuclideanLin_conjTranspose_eq_adjoint (A : Matrix m n 𝕜) :
    A.conjTranspose.toEuclideanLin = A.toEuclideanLin.adjoint :=
  by
  rw [LinearMap.eq_adjoint_iff]
  intro x y
  simp_rw [EuclideanSpace.inner_eq_star_dotProduct, pi_Lp_equiv_to_euclidean_lin, to_lin'_apply,
    star_mul_vec, conj_transpose_conj_transpose, dot_product_mul_vec]
#align matrix.to_euclidean_lin_conj_transpose_eq_adjoint Matrix.toEuclideanLin_conjTranspose_eq_adjoint

end Matrix