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

! This file was ported from Lean 3 source module algebraic_geometry.prime_spectrum.basic
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.PunitInstances
import Mathbin.LinearAlgebra.Finsupp
import Mathbin.RingTheory.Ideal.Over
import Mathbin.RingTheory.Ideal.Prod
import Mathbin.RingTheory.Localization.Away
import Mathbin.RingTheory.Nilpotent
import Mathbin.Topology.Sets.Closeds
import Mathbin.Topology.Sober

/-!
# Prime spectrum of a commutative ring

The prime spectrum of a commutative ring is the type of all prime ideals.
It is naturally endowed with a topology: the Zariski topology.

(It is also naturally endowed with a sheaf of rings,
which is constructed in `algebraic_geometry.structure_sheaf`.)

## Main definitions

* `prime_spectrum R`: The prime spectrum of a commutative ring `R`,
  i.e., the set of all prime ideals of `R`.
* `zero_locus s`: The zero locus of a subset `s` of `R`
  is the subset of `prime_spectrum R` consisting of all prime ideals that contain `s`.
* `vanishing_ideal t`: The vanishing ideal of a subset `t` of `prime_spectrum R`
  is the intersection of points in `t` (viewed as prime ideals).

## Conventions

We denote subsets of rings with `s`, `s'`, etc...
whereas we denote subsets of prime spectra with `t`, `t'`, etc...

## Inspiration/contributors

The contents of this file draw inspiration from <https://github.com/ramonfmir/lean-scheme>
which has contributions from Ramon Fernandez Mir, Kevin Buzzard, Kenny Lau,
and Chris Hughes (on an earlier repository).
-/

noncomputable section

open Classical

universe u v

variable (R : Type u) (S : Type v) [CommRing R] [CommRing S]

/-- The prime spectrum of a commutative ring `R` is the type of all prime ideals of `R`.

It is naturally endowed with a topology (the Zariski topology),
and a sheaf of commutative rings (see `algebraic_geometry.structure_sheaf`).
It is a fundamental building block in algebraic geometry. -/
@[ext]
structure PrimeSpectrum where
  asIdeal : Ideal R
  IsPrime : as_ideal.IsPrime
#align prime_spectrum PrimeSpectrum

attribute [instance] PrimeSpectrum.isPrime

namespace PrimeSpectrum

variable {R S}

instance [Nontrivial R] : Nonempty <| PrimeSpectrum R :=
  let ⟨I, hI⟩ := Ideal.exists_maximal R
  ⟨⟨I, hI.IsPrime⟩⟩

/-- The prime spectrum of the zero ring is empty. -/
theorem pUnit (x : PrimeSpectrum PUnit) : False :=
  x.1.ne_top_iff_one.1 x.2.1 <| Subsingleton.elim (0 : PUnit) 1 ▸ x.1.zero_mem
#align prime_spectrum.punit PrimeSpectrum.pUnit

variable (R S)

/-- The map from the direct sum of prime spectra to the prime spectrum of a direct product. -/
@[simp]
def primeSpectrumProdOfSum : Sum (PrimeSpectrum R) (PrimeSpectrum S) → PrimeSpectrum (R × S)
  | Sum.inl ⟨I, hI⟩ => ⟨Ideal.prod I ⊤, Ideal.isPrime_ideal_prod_top⟩
  | Sum.inr ⟨J, hJ⟩ => ⟨Ideal.prod ⊤ J, Ideal.isPrime_ideal_prod_top'⟩
#align prime_spectrum.prime_spectrum_prod_of_sum PrimeSpectrum.primeSpectrumProdOfSum

/-- The prime spectrum of `R × S` is in bijection with the disjoint unions of the prime spectrum of
`R` and the prime spectrum of `S`. -/
noncomputable def primeSpectrumProd :
    PrimeSpectrum (R × S) ≃ Sum (PrimeSpectrum R) (PrimeSpectrum S) :=
  Equiv.symm <|
    Equiv.ofBijective (primeSpectrumProdOfSum R S)
      (by
        constructor
        · rintro (⟨I, hI⟩ | ⟨J, hJ⟩) (⟨I', hI'⟩ | ⟨J', hJ'⟩) h <;>
            simp only [Ideal.prod.ext_iff, prime_spectrum_prod_of_sum] at h
          · simp only [h]
          · exact False.elim (hI.ne_top h.left)
          · exact False.elim (hJ.ne_top h.right)
          · simp only [h]
        · rintro ⟨I, hI⟩
          rcases(Ideal.ideal_prod_prime I).mp hI with (⟨p, ⟨hp, rfl⟩⟩ | ⟨p, ⟨hp, rfl⟩⟩)
          · exact ⟨Sum.inl ⟨p, hp⟩, rfl⟩
          · exact ⟨Sum.inr ⟨p, hp⟩, rfl⟩)
#align prime_spectrum.prime_spectrum_prod PrimeSpectrum.primeSpectrumProd

variable {R S}

@[simp]
theorem primeSpectrumProd_symm_inl_asIdeal (x : PrimeSpectrum R) :
    ((primeSpectrumProd R S).symm <| Sum.inl x).asIdeal = Ideal.prod x.asIdeal ⊤ :=
  by
  cases x
  rfl
#align prime_spectrum.prime_spectrum_prod_symm_inl_as_ideal PrimeSpectrum.primeSpectrumProd_symm_inl_asIdeal

@[simp]
theorem primeSpectrumProd_symm_inr_asIdeal (x : PrimeSpectrum S) :
    ((primeSpectrumProd R S).symm <| Sum.inr x).asIdeal = Ideal.prod ⊤ x.asIdeal :=
  by
  cases x
  rfl
#align prime_spectrum.prime_spectrum_prod_symm_inr_as_ideal PrimeSpectrum.primeSpectrumProd_symm_inr_asIdeal

/-- The zero locus of a set `s` of elements of a commutative ring `R` is the set of all prime ideals
of the ring that contain the set `s`.

An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`.
At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring
`R` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset of
`prime_spectrum R` where all "functions" in `s` vanish simultaneously.
-/
def zeroLocus (s : Set R) : Set (PrimeSpectrum R) :=
  { x | s ⊆ x.asIdeal }
#align prime_spectrum.zero_locus PrimeSpectrum.zeroLocus

@[simp]
theorem mem_zeroLocus (x : PrimeSpectrum R) (s : Set R) : x ∈ zeroLocus s ↔ s ⊆ x.asIdeal :=
  Iff.rfl
#align prime_spectrum.mem_zero_locus PrimeSpectrum.mem_zeroLocus

@[simp]
theorem zeroLocus_span (s : Set R) : zeroLocus (Ideal.span s : Set R) = zeroLocus s :=
  by
  ext x
  exact (Submodule.gi R R).gc s x.as_ideal
#align prime_spectrum.zero_locus_span PrimeSpectrum.zeroLocus_span

/-- The vanishing ideal of a set `t` of points of the prime spectrum of a commutative ring `R` is
the intersection of all the prime ideals in the set `t`.

An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`.
At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring
`R` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the ideal of `R`
consisting of all "functions" that vanish on all of `t`.
-/
def vanishingIdeal (t : Set (PrimeSpectrum R)) : Ideal R :=
  ⨅ (x : PrimeSpectrum R) (h : x ∈ t), x.asIdeal
#align prime_spectrum.vanishing_ideal PrimeSpectrum.vanishingIdeal

theorem coe_vanishingIdeal (t : Set (PrimeSpectrum R)) :
    (vanishingIdeal t : Set R) = { f : R | ∀ x : PrimeSpectrum R, x ∈ t → f ∈ x.asIdeal } :=
  by
  ext f
  rw [vanishing_ideal, SetLike.mem_coe, Submodule.mem_infᵢ]
  apply forall_congr'; intro x
  rw [Submodule.mem_infᵢ]
#align prime_spectrum.coe_vanishing_ideal PrimeSpectrum.coe_vanishingIdeal

theorem mem_vanishingIdeal (t : Set (PrimeSpectrum R)) (f : R) :
    f ∈ vanishingIdeal t ↔ ∀ x : PrimeSpectrum R, x ∈ t → f ∈ x.asIdeal := by
  rw [← SetLike.mem_coe, coe_vanishing_ideal, Set.mem_setOf_eq]
#align prime_spectrum.mem_vanishing_ideal PrimeSpectrum.mem_vanishingIdeal

@[simp]
theorem vanishingIdeal_singleton (x : PrimeSpectrum R) :
    vanishingIdeal ({x} : Set (PrimeSpectrum R)) = x.asIdeal := by simp [vanishing_ideal]
#align prime_spectrum.vanishing_ideal_singleton PrimeSpectrum.vanishingIdeal_singleton

theorem subset_zeroLocus_iff_le_vanishingIdeal (t : Set (PrimeSpectrum R)) (I : Ideal R) :
    t ⊆ zeroLocus I ↔ I ≤ vanishingIdeal t :=
  ⟨fun h f k => (mem_vanishingIdeal _ _).mpr fun x j => (mem_zeroLocus _ _).mpr (h j) k, fun h =>
    fun x j => (mem_zeroLocus _ _).mpr (le_trans h fun f h => ((mem_vanishingIdeal _ _).mp h) x j)⟩
#align prime_spectrum.subset_zero_locus_iff_le_vanishing_ideal PrimeSpectrum.subset_zeroLocus_iff_le_vanishingIdeal

section Gc

variable (R)

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
theorem gc :
    @GaloisConnection (Ideal R) (Set (PrimeSpectrum R))ᵒᵈ _ _ (fun I => zeroLocus I) fun t =>
      vanishingIdeal t :=
  fun I t => subset_zeroLocus_iff_le_vanishingIdeal t I
#align prime_spectrum.gc PrimeSpectrum.gc

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
theorem gc_set :
    @GaloisConnection (Set R) (Set (PrimeSpectrum R))ᵒᵈ _ _ (fun s => zeroLocus s) fun t =>
      vanishingIdeal t :=
  by
  have ideal_gc : GaloisConnection Ideal.span coe := (Submodule.gi R R).gc
  simpa [zero_locus_span, Function.comp] using ideal_gc.compose (gc R)
#align prime_spectrum.gc_set PrimeSpectrum.gc_set

theorem subset_zeroLocus_iff_subset_vanishingIdeal (t : Set (PrimeSpectrum R)) (s : Set R) :
    t ⊆ zeroLocus s ↔ s ⊆ vanishingIdeal t :=
  (gc_set R) s t
#align prime_spectrum.subset_zero_locus_iff_subset_vanishing_ideal PrimeSpectrum.subset_zeroLocus_iff_subset_vanishingIdeal

end Gc

theorem subset_vanishingIdeal_zeroLocus (s : Set R) : s ⊆ vanishingIdeal (zeroLocus s) :=
  (gc_set R).le_u_l s
#align prime_spectrum.subset_vanishing_ideal_zero_locus PrimeSpectrum.subset_vanishingIdeal_zeroLocus

theorem le_vanishingIdeal_zeroLocus (I : Ideal R) : I ≤ vanishingIdeal (zeroLocus I) :=
  (gc R).le_u_l I
#align prime_spectrum.le_vanishing_ideal_zero_locus PrimeSpectrum.le_vanishingIdeal_zeroLocus

@[simp]
theorem vanishingIdeal_zeroLocus_eq_radical (I : Ideal R) :
    vanishingIdeal (zeroLocus (I : Set R)) = I.radical :=
  Ideal.ext fun f =>
    by
    rw [mem_vanishing_ideal, Ideal.radical_eq_infₛ, Submodule.mem_infₛ]
    exact ⟨fun h x hx => h ⟨x, hx.2⟩ hx.1, fun h x hx => h x.1 ⟨hx, x.2⟩⟩
#align prime_spectrum.vanishing_ideal_zero_locus_eq_radical PrimeSpectrum.vanishingIdeal_zeroLocus_eq_radical

@[simp]
theorem zeroLocus_radical (I : Ideal R) : zeroLocus (I.radical : Set R) = zeroLocus I :=
  vanishingIdeal_zeroLocus_eq_radical I ▸ (gc R).l_u_l_eq_l I
#align prime_spectrum.zero_locus_radical PrimeSpectrum.zeroLocus_radical

theorem subset_zeroLocus_vanishingIdeal (t : Set (PrimeSpectrum R)) :
    t ⊆ zeroLocus (vanishingIdeal t) :=
  (gc R).l_u_le t
#align prime_spectrum.subset_zero_locus_vanishing_ideal PrimeSpectrum.subset_zeroLocus_vanishingIdeal

theorem zeroLocus_anti_mono {s t : Set R} (h : s ⊆ t) : zeroLocus t ⊆ zeroLocus s :=
  (gc_set R).monotone_l h
#align prime_spectrum.zero_locus_anti_mono PrimeSpectrum.zeroLocus_anti_mono

theorem zeroLocus_anti_mono_ideal {s t : Ideal R} (h : s ≤ t) :
    zeroLocus (t : Set R) ⊆ zeroLocus (s : Set R) :=
  (gc R).monotone_l h
#align prime_spectrum.zero_locus_anti_mono_ideal PrimeSpectrum.zeroLocus_anti_mono_ideal

theorem vanishingIdeal_anti_mono {s t : Set (PrimeSpectrum R)} (h : s ⊆ t) :
    vanishingIdeal t ≤ vanishingIdeal s :=
  (gc R).monotone_u h
#align prime_spectrum.vanishing_ideal_anti_mono PrimeSpectrum.vanishingIdeal_anti_mono

theorem zeroLocus_subset_zeroLocus_iff (I J : Ideal R) :
    zeroLocus (I : Set R) ⊆ zeroLocus (J : Set R) ↔ J ≤ I.radical :=
  ⟨fun h =>
    Ideal.radical_le_radical_iff.mp
      (vanishingIdeal_zeroLocus_eq_radical I ▸
        vanishingIdeal_zeroLocus_eq_radical J ▸ vanishingIdeal_anti_mono h),
    fun h => zeroLocus_radical I ▸ zeroLocus_anti_mono_ideal h⟩
#align prime_spectrum.zero_locus_subset_zero_locus_iff PrimeSpectrum.zeroLocus_subset_zeroLocus_iff

theorem zeroLocus_subset_zeroLocus_singleton_iff (f g : R) :
    zeroLocus ({f} : Set R) ⊆ zeroLocus {g} ↔ g ∈ (Ideal.span ({f} : Set R)).radical := by
  rw [← zero_locus_span {f}, ← zero_locus_span {g}, zero_locus_subset_zero_locus_iff, Ideal.span_le,
    Set.singleton_subset_iff, SetLike.mem_coe]
#align prime_spectrum.zero_locus_subset_zero_locus_singleton_iff PrimeSpectrum.zeroLocus_subset_zeroLocus_singleton_iff

theorem zeroLocus_bot : zeroLocus ((⊥ : Ideal R) : Set R) = Set.univ :=
  (gc R).l_bot
#align prime_spectrum.zero_locus_bot PrimeSpectrum.zeroLocus_bot

@[simp]
theorem zeroLocus_singleton_zero : zeroLocus ({0} : Set R) = Set.univ :=
  zeroLocus_bot
#align prime_spectrum.zero_locus_singleton_zero PrimeSpectrum.zeroLocus_singleton_zero

@[simp]
theorem zeroLocus_empty : zeroLocus (∅ : Set R) = Set.univ :=
  (gc_set R).l_bot
#align prime_spectrum.zero_locus_empty PrimeSpectrum.zeroLocus_empty

@[simp]
theorem vanishingIdeal_univ : vanishingIdeal (∅ : Set (PrimeSpectrum R)) = ⊤ := by
  simpa using (gc R).u_top
#align prime_spectrum.vanishing_ideal_univ PrimeSpectrum.vanishingIdeal_univ

theorem zeroLocus_empty_of_one_mem {s : Set R} (h : (1 : R) ∈ s) : zeroLocus s = ∅ :=
  by
  rw [Set.eq_empty_iff_forall_not_mem]
  intro x hx
  rw [mem_zero_locus] at hx
  have x_prime : x.as_ideal.is_prime := by infer_instance
  have eq_top : x.as_ideal = ⊤ := by
    rw [Ideal.eq_top_iff_one]
    exact hx h
  apply x_prime.ne_top eq_top
#align prime_spectrum.zero_locus_empty_of_one_mem PrimeSpectrum.zeroLocus_empty_of_one_mem

@[simp]
theorem zeroLocus_singleton_one : zeroLocus ({1} : Set R) = ∅ :=
  zeroLocus_empty_of_one_mem (Set.mem_singleton (1 : R))
#align prime_spectrum.zero_locus_singleton_one PrimeSpectrum.zeroLocus_singleton_one

theorem zeroLocus_empty_iff_eq_top {I : Ideal R} : zeroLocus (I : Set R) = ∅ ↔ I = ⊤ :=
  by
  constructor
  · contrapose!
    intro h
    rcases Ideal.exists_le_maximal I h with ⟨M, hM, hIM⟩
    exact Set.Nonempty.ne_empty ⟨⟨M, hM.is_prime⟩, hIM⟩
  · rintro rfl
    apply zero_locus_empty_of_one_mem
    trivial
#align prime_spectrum.zero_locus_empty_iff_eq_top PrimeSpectrum.zeroLocus_empty_iff_eq_top

@[simp]
theorem zeroLocus_univ : zeroLocus (Set.univ : Set R) = ∅ :=
  zeroLocus_empty_of_one_mem (Set.mem_univ 1)
#align prime_spectrum.zero_locus_univ PrimeSpectrum.zeroLocus_univ

theorem vanishingIdeal_eq_top_iff {s : Set (PrimeSpectrum R)} : vanishingIdeal s = ⊤ ↔ s = ∅ := by
  rw [← top_le_iff, ← subset_zero_locus_iff_le_vanishing_ideal, Submodule.top_coe, zero_locus_univ,
    Set.subset_empty_iff]
#align prime_spectrum.vanishing_ideal_eq_top_iff PrimeSpectrum.vanishingIdeal_eq_top_iff

theorem zeroLocus_sup (I J : Ideal R) :
    zeroLocus ((I ⊔ J : Ideal R) : Set R) = zeroLocus I ∩ zeroLocus J :=
  (gc R).l_sup
#align prime_spectrum.zero_locus_sup PrimeSpectrum.zeroLocus_sup

theorem zeroLocus_union (s s' : Set R) : zeroLocus (s ∪ s') = zeroLocus s ∩ zeroLocus s' :=
  (gc_set R).l_sup
#align prime_spectrum.zero_locus_union PrimeSpectrum.zeroLocus_union

theorem vanishingIdeal_union (t t' : Set (PrimeSpectrum R)) :
    vanishingIdeal (t ∪ t') = vanishingIdeal t ⊓ vanishingIdeal t' :=
  (gc R).u_inf
#align prime_spectrum.vanishing_ideal_union PrimeSpectrum.vanishingIdeal_union

theorem zeroLocus_supᵢ {ι : Sort _} (I : ι → Ideal R) :
    zeroLocus ((⨆ i, I i : Ideal R) : Set R) = ⋂ i, zeroLocus (I i) :=
  (gc R).l_supᵢ
#align prime_spectrum.zero_locus_supr PrimeSpectrum.zeroLocus_supᵢ

theorem zeroLocus_unionᵢ {ι : Sort _} (s : ι → Set R) :
    zeroLocus (⋃ i, s i) = ⋂ i, zeroLocus (s i) :=
  (gc_set R).l_supᵢ
#align prime_spectrum.zero_locus_Union PrimeSpectrum.zeroLocus_unionᵢ

theorem zeroLocus_bUnion (s : Set (Set R)) :
    zeroLocus (⋃ s' ∈ s, s' : Set R) = ⋂ s' ∈ s, zeroLocus s' := by simp only [zero_locus_Union]
#align prime_spectrum.zero_locus_bUnion PrimeSpectrum.zeroLocus_bUnion

theorem vanishingIdeal_unionᵢ {ι : Sort _} (t : ι → Set (PrimeSpectrum R)) :
    vanishingIdeal (⋃ i, t i) = ⨅ i, vanishingIdeal (t i) :=
  (gc R).u_infᵢ
#align prime_spectrum.vanishing_ideal_Union PrimeSpectrum.vanishingIdeal_unionᵢ

theorem zeroLocus_inf (I J : Ideal R) :
    zeroLocus ((I ⊓ J : Ideal R) : Set R) = zeroLocus I ∪ zeroLocus J :=
  Set.ext fun x => x.2.inf_le
#align prime_spectrum.zero_locus_inf PrimeSpectrum.zeroLocus_inf

theorem union_zeroLocus (s s' : Set R) :
    zeroLocus s ∪ zeroLocus s' = zeroLocus (Ideal.span s ⊓ Ideal.span s' : Ideal R) :=
  by
  rw [zero_locus_inf]
  simp
#align prime_spectrum.union_zero_locus PrimeSpectrum.union_zeroLocus

theorem zeroLocus_mul (I J : Ideal R) :
    zeroLocus ((I * J : Ideal R) : Set R) = zeroLocus I ∪ zeroLocus J :=
  Set.ext fun x => x.2.mul_le
#align prime_spectrum.zero_locus_mul PrimeSpectrum.zeroLocus_mul

theorem zeroLocus_singleton_mul (f g : R) :
    zeroLocus ({f * g} : Set R) = zeroLocus {f} ∪ zeroLocus {g} :=
  Set.ext fun x => by simpa using x.2.mul_mem_iff_mem_or_mem
#align prime_spectrum.zero_locus_singleton_mul PrimeSpectrum.zeroLocus_singleton_mul

@[simp]
theorem zeroLocus_pow (I : Ideal R) {n : ℕ} (hn : 0 < n) :
    zeroLocus ((I ^ n : Ideal R) : Set R) = zeroLocus I :=
  zeroLocus_radical (I ^ n) ▸ (I.radical_pow n hn).symm ▸ zeroLocus_radical I
#align prime_spectrum.zero_locus_pow PrimeSpectrum.zeroLocus_pow

@[simp]
theorem zeroLocus_singleton_pow (f : R) (n : ℕ) (hn : 0 < n) :
    zeroLocus ({f ^ n} : Set R) = zeroLocus {f} :=
  Set.ext fun x => by simpa using x.2.pow_mem_iff_mem n hn
#align prime_spectrum.zero_locus_singleton_pow PrimeSpectrum.zeroLocus_singleton_pow

theorem sup_vanishingIdeal_le (t t' : Set (PrimeSpectrum R)) :
    vanishingIdeal t ⊔ vanishingIdeal t' ≤ vanishingIdeal (t ∩ t') :=
  by
  intro r
  rw [Submodule.mem_sup, mem_vanishing_ideal]
  rintro ⟨f, hf, g, hg, rfl⟩ x ⟨hxt, hxt'⟩
  rw [mem_vanishing_ideal] at hf hg
  apply Submodule.add_mem <;> solve_by_elim
#align prime_spectrum.sup_vanishing_ideal_le PrimeSpectrum.sup_vanishingIdeal_le

theorem mem_compl_zeroLocus_iff_not_mem {f : R} {I : PrimeSpectrum R} :
    I ∈ (zeroLocus {f} : Set (PrimeSpectrum R))ᶜ ↔ f ∉ I.asIdeal := by
  rw [Set.mem_compl_iff, mem_zero_locus, Set.singleton_subset_iff] <;> rfl
#align prime_spectrum.mem_compl_zero_locus_iff_not_mem PrimeSpectrum.mem_compl_zeroLocus_iff_not_mem

/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets
of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/
instance zariskiTopology : TopologicalSpace (PrimeSpectrum R) :=
  TopologicalSpace.ofClosed (Set.range PrimeSpectrum.zeroLocus) ⟨Set.univ, by simp⟩
    (by
      intro Zs h
      rw [Set.interₛ_eq_interᵢ]
      choose f hf using fun i : Zs => h i.Prop
      simp only [← hf]
      exact ⟨_, zero_locus_Union _⟩)
    (by
      rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩
      exact ⟨_, (union_zero_locus s t).symm⟩)
#align prime_spectrum.zariski_topology PrimeSpectrum.zariskiTopology

theorem isOpen_iff (U : Set (PrimeSpectrum R)) : IsOpen U ↔ ∃ s, Uᶜ = zeroLocus s := by
  simp only [@eq_comm _ (Uᶜ)] <;> rfl
#align prime_spectrum.is_open_iff PrimeSpectrum.isOpen_iff

theorem isClosed_iff_zeroLocus (Z : Set (PrimeSpectrum R)) : IsClosed Z ↔ ∃ s, Z = zeroLocus s := by
  rw [← isOpen_compl_iff, is_open_iff, compl_compl]
#align prime_spectrum.is_closed_iff_zero_locus PrimeSpectrum.isClosed_iff_zeroLocus

theorem isClosed_iff_zeroLocus_ideal (Z : Set (PrimeSpectrum R)) :
    IsClosed Z ↔ ∃ I : Ideal R, Z = zeroLocus I :=
  (isClosed_iff_zeroLocus _).trans
    ⟨fun ⟨s, hs⟩ => ⟨_, (zeroLocus_span s).substr hs⟩, fun ⟨I, hI⟩ => ⟨I, hI⟩⟩
#align prime_spectrum.is_closed_iff_zero_locus_ideal PrimeSpectrum.isClosed_iff_zeroLocus_ideal

theorem isClosed_iff_zeroLocus_radical_ideal (Z : Set (PrimeSpectrum R)) :
    IsClosed Z ↔ ∃ I : Ideal R, I.IsRadical ∧ Z = zeroLocus I :=
  (isClosed_iff_zeroLocus_ideal _).trans
    ⟨fun ⟨I, hI⟩ => ⟨_, I.radical_isRadical, (zeroLocus_radical I).substr hI⟩, fun ⟨I, _, hI⟩ =>
      ⟨I, hI⟩⟩
#align prime_spectrum.is_closed_iff_zero_locus_radical_ideal PrimeSpectrum.isClosed_iff_zeroLocus_radical_ideal

theorem isClosed_zeroLocus (s : Set R) : IsClosed (zeroLocus s) :=
  by
  rw [is_closed_iff_zero_locus]
  exact ⟨s, rfl⟩
#align prime_spectrum.is_closed_zero_locus PrimeSpectrum.isClosed_zeroLocus

theorem isClosed_singleton_iff_isMaximal (x : PrimeSpectrum R) :
    IsClosed ({x} : Set (PrimeSpectrum R)) ↔ x.asIdeal.IsMaximal :=
  by
  refine' (is_closed_iff_zero_locus _).trans ⟨fun h => _, fun h => _⟩
  · obtain ⟨s, hs⟩ := h
    rw [eq_comm, Set.eq_singleton_iff_unique_mem] at hs
    refine'
      ⟨⟨x.2.1, fun I hI =>
          Classical.not_not.1
            (mt (Ideal.exists_le_maximal I) <| not_exists.2 fun J => not_and.2 fun hJ hIJ => _)⟩⟩
    exact
      ne_of_lt (lt_of_lt_of_le hI hIJ)
        (symm <|
          congr_arg PrimeSpectrum.asIdeal
            (hs.2 ⟨J, hJ.is_prime⟩ fun r hr => hIJ (le_of_lt hI <| hs.1 hr)))
  · refine' ⟨x.as_ideal.1, _⟩
    rw [eq_comm, Set.eq_singleton_iff_unique_mem]
    refine' ⟨fun _ h => h, fun y hy => PrimeSpectrum.ext _ _ (h.eq_of_le y.2.ne_top hy).symm⟩
#align prime_spectrum.is_closed_singleton_iff_is_maximal PrimeSpectrum.isClosed_singleton_iff_isMaximal

theorem zeroLocus_vanishingIdeal_eq_closure (t : Set (PrimeSpectrum R)) :
    zeroLocus (vanishingIdeal t : Set R) = closure t :=
  by
  apply Set.Subset.antisymm
  · rintro x hx t' ⟨ht', ht⟩
    obtain ⟨fs, rfl⟩ : ∃ s, t' = zero_locus s := by rwa [is_closed_iff_zero_locus] at ht'
    rw [subset_zero_locus_iff_subset_vanishing_ideal] at ht
    exact Set.Subset.trans ht hx
  · rw [(is_closed_zero_locus _).closure_subset_iff]
    exact subset_zero_locus_vanishing_ideal t
#align prime_spectrum.zero_locus_vanishing_ideal_eq_closure PrimeSpectrum.zeroLocus_vanishingIdeal_eq_closure

theorem vanishingIdeal_closure (t : Set (PrimeSpectrum R)) :
    vanishingIdeal (closure t) = vanishingIdeal t :=
  zeroLocus_vanishingIdeal_eq_closure t ▸ (gc R).u_l_u_eq_u t
#align prime_spectrum.vanishing_ideal_closure PrimeSpectrum.vanishingIdeal_closure

theorem closure_singleton (x) : closure ({x} : Set (PrimeSpectrum R)) = zeroLocus x.asIdeal := by
  rw [← zero_locus_vanishing_ideal_eq_closure, vanishing_ideal_singleton]
#align prime_spectrum.closure_singleton PrimeSpectrum.closure_singleton

theorem isRadical_vanishingIdeal (s : Set (PrimeSpectrum R)) : (vanishingIdeal s).IsRadical :=
  by
  rw [← vanishing_ideal_closure, ← zero_locus_vanishing_ideal_eq_closure,
    vanishing_ideal_zero_locus_eq_radical]
  apply Ideal.radical_isRadical
#align prime_spectrum.is_radical_vanishing_ideal PrimeSpectrum.isRadical_vanishingIdeal

theorem vanishingIdeal_anti_mono_iff {s t : Set (PrimeSpectrum R)} (ht : IsClosed t) :
    s ⊆ t ↔ vanishingIdeal t ≤ vanishingIdeal s :=
  ⟨vanishingIdeal_anti_mono, fun h =>
    by
    rw [← ht.closure_subset_iff, ← ht.closure_eq]
    convert← zero_locus_anti_mono_ideal h <;> apply zero_locus_vanishing_ideal_eq_closure⟩
#align prime_spectrum.vanishing_ideal_anti_mono_iff PrimeSpectrum.vanishingIdeal_anti_mono_iff

theorem vanishingIdeal_strict_anti_mono_iff {s t : Set (PrimeSpectrum R)} (hs : IsClosed s)
    (ht : IsClosed t) : s ⊂ t ↔ vanishingIdeal t < vanishingIdeal s := by
  rw [Set.ssubset_def, vanishing_ideal_anti_mono_iff hs, vanishing_ideal_anti_mono_iff ht,
    lt_iff_le_not_le]
#align prime_spectrum.vanishing_ideal_strict_anti_mono_iff PrimeSpectrum.vanishingIdeal_strict_anti_mono_iff

/-- The antitone order embedding of closed subsets of `Spec R` into ideals of `R`. -/
def closedsEmbedding (R : Type _) [CommRing R] :
    (TopologicalSpace.Closeds <| PrimeSpectrum R)ᵒᵈ ↪o Ideal R :=
  OrderEmbedding.ofMapLEIff (fun s => vanishingIdeal s.ofDual) fun s t =>
    (vanishingIdeal_anti_mono_iff s.2).symm
#align prime_spectrum.closeds_embedding PrimeSpectrum.closedsEmbedding

theorem t1Space_iff_isField [IsDomain R] : T1Space (PrimeSpectrum R) ↔ IsField R :=
  by
  refine' ⟨_, fun h => _⟩
  · intro h
    have hbot : Ideal.IsPrime (⊥ : Ideal R) := Ideal.bot_prime
    exact
      Classical.not_not.1
        (mt
          (Ring.ne_bot_of_isMaximal_of_not_isField <|
            (is_closed_singleton_iff_is_maximal _).1 (T1Space.t1 ⟨⊥, hbot⟩))
          (Classical.not_not.2 rfl))
  · refine' ⟨fun x => (is_closed_singleton_iff_is_maximal x).2 _⟩
    by_cases hx : x.as_ideal = ⊥
    · letI := h.to_field
      exact hx.symm ▸ Ideal.bot_isMaximal
    · exact absurd h (Ring.not_isField_iff_exists_prime.2 ⟨x.as_ideal, ⟨hx, x.2⟩⟩)
#align prime_spectrum.t1_space_iff_is_field PrimeSpectrum.t1Space_iff_isField

-- mathport name: «exprZ( )»
local notation "Z(" a ")" => zeroLocus (a : Set R)

theorem isIrreducible_zeroLocus_iff_of_radical (I : Ideal R) (hI : I.IsRadical) :
    IsIrreducible (zeroLocus (I : Set R)) ↔ I.IsPrime :=
  by
  rw [Ideal.isPrime_iff, IsIrreducible]
  apply and_congr
  · rw [Set.nonempty_iff_ne_empty, Ne.def, zero_locus_empty_iff_eq_top]
  · trans ∀ x y : Ideal R, Z(I) ⊆ Z(x) ∪ Z(y) → Z(I) ⊆ Z(x) ∨ Z(I) ⊆ Z(y)
    · simp_rw [isPreirreducible_iff_closed_union_closed, is_closed_iff_zero_locus_ideal]
      constructor
      · rintro h x y
        exact h _ _ ⟨x, rfl⟩ ⟨y, rfl⟩
      · rintro h _ _ ⟨x, rfl⟩ ⟨y, rfl⟩
        exact h x y
    · simp_rw [← zero_locus_inf, subset_zero_locus_iff_le_vanishing_ideal,
        vanishing_ideal_zero_locus_eq_radical, hI.radical]
      constructor
      · simp_rw [← SetLike.mem_coe, ← Set.singleton_subset_iff, ← Ideal.span_le, ←
          Ideal.span_singleton_mul_span_singleton]
        refine' fun h x y h' => h _ _ _
        rw [← hI.radical_le_iff] at h'⊢
        simpa only [Ideal.radical_inf, Ideal.radical_mul] using h'
      · simp_rw [or_iff_not_imp_left, SetLike.not_le_iff_exists]
        rintro h s t h' ⟨x, hx, hx'⟩ y hy
        exact h (h' ⟨Ideal.mul_mem_right _ _ hx, Ideal.mul_mem_left _ _ hy⟩) hx'
#align prime_spectrum.is_irreducible_zero_locus_iff_of_radical PrimeSpectrum.isIrreducible_zeroLocus_iff_of_radical

theorem isIrreducible_zeroLocus_iff (I : Ideal R) :
    IsIrreducible (zeroLocus (I : Set R)) ↔ I.radical.IsPrime :=
  zeroLocus_radical I ▸ isIrreducible_zeroLocus_iff_of_radical _ I.radical_isRadical
#align prime_spectrum.is_irreducible_zero_locus_iff PrimeSpectrum.isIrreducible_zeroLocus_iff

theorem isIrreducible_iff_vanishingIdeal_isPrime {s : Set (PrimeSpectrum R)} :
    IsIrreducible s ↔ (vanishingIdeal s).IsPrime := by
  rw [← isIrreducible_iff_closure, ← zero_locus_vanishing_ideal_eq_closure,
    is_irreducible_zero_locus_iff_of_radical _ (is_radical_vanishing_ideal s)]
#align prime_spectrum.is_irreducible_iff_vanishing_ideal_is_prime PrimeSpectrum.isIrreducible_iff_vanishingIdeal_isPrime

instance [IsDomain R] : IrreducibleSpace (PrimeSpectrum R) :=
  by
  rw [irreducibleSpace_def, Set.top_eq_univ, ← zero_locus_bot, is_irreducible_zero_locus_iff]
  simpa using Ideal.bot_prime

instance : QuasiSober (PrimeSpectrum R) :=
  ⟨fun S h₁ h₂ =>
    ⟨⟨_, isIrreducible_iff_vanishingIdeal_isPrime.1 h₁⟩, by
      rw [IsGenericPoint, closure_singleton, zero_locus_vanishing_ideal_eq_closure, h₂.closure_eq]⟩⟩

section Comap

variable {S' : Type _} [CommRing S']

theorem preimage_comap_zeroLocus_aux (f : R →+* S) (s : Set R) :
    (fun y => ⟨Ideal.comap f y.asIdeal, inferInstance⟩ : PrimeSpectrum S → PrimeSpectrum R) ⁻¹'
        zeroLocus s =
      zeroLocus (f '' s) :=
  by
  ext x
  simp only [mem_zero_locus, Set.image_subset_iff]
  rfl
#align prime_spectrum.preimage_comap_zero_locus_aux PrimeSpectrum.preimage_comap_zeroLocus_aux

/-- The function between prime spectra of commutative rings induced by a ring homomorphism.
This function is continuous. -/
def comap (f : R →+* S) : C(PrimeSpectrum S, PrimeSpectrum R)
    where
  toFun y := ⟨Ideal.comap f y.asIdeal, inferInstance⟩
  continuous_toFun :=
    by
    simp only [continuous_iff_isClosed, is_closed_iff_zero_locus]
    rintro _ ⟨s, rfl⟩
    exact ⟨_, preimage_comap_zero_locus_aux f s⟩
#align prime_spectrum.comap PrimeSpectrum.comap

variable (f : R →+* S)

@[simp]
theorem comap_asIdeal (y : PrimeSpectrum S) : (comap f y).asIdeal = Ideal.comap f y.asIdeal :=
  rfl
#align prime_spectrum.comap_as_ideal PrimeSpectrum.comap_asIdeal

@[simp]
theorem comap_id : comap (RingHom.id R) = ContinuousMap.id _ :=
  by
  ext
  rfl
#align prime_spectrum.comap_id PrimeSpectrum.comap_id

@[simp]
theorem comap_comp (f : R →+* S) (g : S →+* S') : comap (g.comp f) = (comap f).comp (comap g) :=
  rfl
#align prime_spectrum.comap_comp PrimeSpectrum.comap_comp

theorem comap_comp_apply (f : R →+* S) (g : S →+* S') (x : PrimeSpectrum S') :
    PrimeSpectrum.comap (g.comp f) x = (PrimeSpectrum.comap f) (PrimeSpectrum.comap g x) :=
  rfl
#align prime_spectrum.comap_comp_apply PrimeSpectrum.comap_comp_apply

@[simp]
theorem preimage_comap_zeroLocus (s : Set R) : comap f ⁻¹' zeroLocus s = zeroLocus (f '' s) :=
  preimage_comap_zeroLocus_aux f s
#align prime_spectrum.preimage_comap_zero_locus PrimeSpectrum.preimage_comap_zeroLocus

theorem comap_injective_of_surjective (f : R →+* S) (hf : Function.Surjective f) :
    Function.Injective (comap f) := fun x y h =>
  PrimeSpectrum.ext _ _
    (Ideal.comap_injective_of_surjective f hf
      (congr_arg PrimeSpectrum.asIdeal h : (comap f x).asIdeal = (comap f y).asIdeal))
#align prime_spectrum.comap_injective_of_surjective PrimeSpectrum.comap_injective_of_surjective

theorem comap_singleton_isClosed_of_surjective (f : R →+* S) (hf : Function.Surjective f)
    (x : PrimeSpectrum S) (hx : IsClosed ({x} : Set (PrimeSpectrum S))) :
    IsClosed ({comap f x} : Set (PrimeSpectrum R)) :=
  haveI : x.as_ideal.is_maximal := (is_closed_singleton_iff_is_maximal x).1 hx
  (is_closed_singleton_iff_is_maximal _).2 (Ideal.comap_isMaximal_of_surjective f hf)
#align prime_spectrum.comap_singleton_is_closed_of_surjective PrimeSpectrum.comap_singleton_isClosed_of_surjective

theorem comap_singleton_isClosed_of_isIntegral (f : R →+* S) (hf : f.IsIntegral)
    (x : PrimeSpectrum S) (hx : IsClosed ({x} : Set (PrimeSpectrum S))) :
    IsClosed ({comap f x} : Set (PrimeSpectrum R)) :=
  (isClosed_singleton_iff_isMaximal _).2
    (Ideal.isMaximal_comap_of_isIntegral_of_is_maximal' f hf x.asIdeal <|
      (isClosed_singleton_iff_isMaximal x).1 hx)
#align prime_spectrum.comap_singleton_is_closed_of_is_integral PrimeSpectrum.comap_singleton_isClosed_of_isIntegral

variable (S)

theorem localization_comap_inducing [Algebra R S] (M : Submonoid R) [IsLocalization M S] :
    Inducing (comap (algebraMap R S)) := by
  constructor
  rw [topologicalSpace_eq_iff]
  intro U
  simp_rw [← isClosed_compl_iff]
  generalize Uᶜ = Z
  simp_rw [isClosed_induced_iff, is_closed_iff_zero_locus]
  constructor
  · rintro ⟨s, rfl⟩
    refine' ⟨_, ⟨algebraMap R S ⁻¹' Ideal.span s, rfl⟩, _⟩
    rw [preimage_comap_zero_locus, ← zero_locus_span, ← zero_locus_span s]
    congr 1
    exact congr_arg Submodule.carrier (IsLocalization.map_comap M S (Ideal.span s))
  · rintro ⟨_, ⟨t, rfl⟩, rfl⟩
    simp
#align prime_spectrum.localization_comap_inducing PrimeSpectrum.localization_comap_inducing

theorem localization_comap_injective [Algebra R S] (M : Submonoid R) [IsLocalization M S] :
    Function.Injective (comap (algebraMap R S)) :=
  by
  intro p q h
  replace h := congr_arg (fun x : PrimeSpectrum R => Ideal.map (algebraMap R S) x.asIdeal) h
  dsimp only at h
  erw [IsLocalization.map_comap M S, IsLocalization.map_comap M S] at h
  ext1
  exact h
#align prime_spectrum.localization_comap_injective PrimeSpectrum.localization_comap_injective

theorem localization_comap_embedding [Algebra R S] (M : Submonoid R) [IsLocalization M S] :
    Embedding (comap (algebraMap R S)) :=
  ⟨localization_comap_inducing S M, localization_comap_injective S M⟩
#align prime_spectrum.localization_comap_embedding PrimeSpectrum.localization_comap_embedding

theorem localization_comap_range [Algebra R S] (M : Submonoid R) [IsLocalization M S] :
    Set.range (comap (algebraMap R S)) = { p | Disjoint (M : Set R) p.asIdeal } :=
  by
  ext x
  constructor
  · simp_rw [disjoint_iff_inf_le]
    rintro ⟨p, rfl⟩ x ⟨hx₁, hx₂⟩
    exact (p.2.1 : ¬_) (p.as_ideal.eq_top_of_is_unit_mem hx₂ (IsLocalization.map_units S ⟨x, hx₁⟩))
  · intro h
    use ⟨x.as_ideal.map (algebraMap R S), IsLocalization.isPrime_of_isPrime_disjoint M S _ x.2 h⟩
    ext1
    exact IsLocalization.comap_map_of_isPrime_disjoint M S _ x.2 h
#align prime_spectrum.localization_comap_range PrimeSpectrum.localization_comap_range

section SpecOfSurjective

/-! The comap of a surjective ring homomorphism is a closed embedding between the prime spectra. -/

open Function RingHom

theorem comap_inducing_of_surjective (hf : Surjective f) : Inducing (comap f) :=
  {
    induced :=
      by
      simp_rw [topologicalSpace_eq_iff, ← isClosed_compl_iff, isClosed_induced_iff,
        is_closed_iff_zero_locus]
      refine' fun s =>
        ⟨fun ⟨F, hF⟩ =>
          ⟨zero_locus (f ⁻¹' F), ⟨f ⁻¹' F, rfl⟩, by
            rw [preimage_comap_zero_locus, surjective.image_preimage hf, hF]⟩,
          _⟩
      rintro ⟨-, ⟨F, rfl⟩, hF⟩
      exact ⟨f '' F, hF.symm.trans (preimage_comap_zero_locus f F)⟩ }
#align prime_spectrum.comap_inducing_of_surjective PrimeSpectrum.comap_inducing_of_surjective

theorem image_comap_zeroLocus_eq_zeroLocus_comap (hf : Surjective f) (I : Ideal S) :
    comap f '' zeroLocus I = zeroLocus (I.comap f) :=
  by
  simp only [Set.ext_iff, Set.mem_image, mem_zero_locus, SetLike.coe_subset_coe]
  refine' fun p => ⟨_, fun h_I_p => _⟩
  · rintro ⟨p, hp, rfl⟩ a ha
    exact hp ha
  · have hp : ker f ≤ p.as_ideal := (Ideal.comap_mono bot_le).trans h_I_p
    refine' ⟨⟨p.as_ideal.map f, Ideal.map_isPrime_of_surjective hf hp⟩, fun x hx => _, _⟩
    · obtain ⟨x', rfl⟩ := hf x
      exact Ideal.mem_map_of_mem f (h_I_p hx)
    · ext x
      change f x ∈ p.as_ideal.map f ↔ _
      rw [Ideal.mem_map_iff_of_surjective f hf]
      refine' ⟨_, fun hx => ⟨x, hx, rfl⟩⟩
      rintro ⟨x', hx', heq⟩
      rw [← sub_sub_cancel x' x]
      refine' p.as_ideal.sub_mem hx' (hp _)
      rwa [mem_ker, map_sub, sub_eq_zero]
#align prime_spectrum.image_comap_zero_locus_eq_zero_locus_comap PrimeSpectrum.image_comap_zeroLocus_eq_zeroLocus_comap

theorem range_comap_of_surjective (hf : Surjective f) : Set.range (comap f) = zeroLocus (ker f) :=
  by
  rw [← Set.image_univ]
  convert image_comap_zero_locus_eq_zero_locus_comap _ _ hf _
  rw [zero_locus_bot]
#align prime_spectrum.range_comap_of_surjective PrimeSpectrum.range_comap_of_surjective

theorem isClosed_range_comap_of_surjective (hf : Surjective f) : IsClosed (Set.range (comap f)) :=
  by
  rw [range_comap_of_surjective _ f hf]
  exact is_closed_zero_locus ↑(ker f)
#align prime_spectrum.is_closed_range_comap_of_surjective PrimeSpectrum.isClosed_range_comap_of_surjective

theorem closedEmbedding_comap_of_surjective (hf : Surjective f) : ClosedEmbedding (comap f) :=
  { induced := (comap_inducing_of_surjective S f hf).induced
    inj := comap_injective_of_surjective f hf
    closed_range := isClosed_range_comap_of_surjective S f hf }
#align prime_spectrum.closed_embedding_comap_of_surjective PrimeSpectrum.closedEmbedding_comap_of_surjective

end SpecOfSurjective

end Comap

section BasicOpen

/-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/
def basicOpen (r : R) : TopologicalSpace.Opens (PrimeSpectrum R)
    where
  carrier := { x | r ∉ x.asIdeal }
  is_open' := ⟨{r}, Set.ext fun x => Set.singleton_subset_iff.trans <| Classical.not_not.symm⟩
#align prime_spectrum.basic_open PrimeSpectrum.basicOpen

@[simp]
theorem mem_basicOpen (f : R) (x : PrimeSpectrum R) : x ∈ basicOpen f ↔ f ∉ x.asIdeal :=
  Iff.rfl
#align prime_spectrum.mem_basic_open PrimeSpectrum.mem_basicOpen

theorem isOpen_basicOpen {a : R} : IsOpen (basicOpen a : Set (PrimeSpectrum R)) :=
  (basicOpen a).IsOpen
#align prime_spectrum.is_open_basic_open PrimeSpectrum.isOpen_basicOpen

@[simp]
theorem basicOpen_eq_zeroLocus_compl (r : R) :
    (basicOpen r : Set (PrimeSpectrum R)) = zeroLocus {r}ᶜ :=
  Set.ext fun x => by simpa only [Set.mem_compl_iff, mem_zero_locus, Set.singleton_subset_iff]
#align prime_spectrum.basic_open_eq_zero_locus_compl PrimeSpectrum.basicOpen_eq_zeroLocus_compl

@[simp]
theorem basicOpen_one : basicOpen (1 : R) = ⊤ :=
  TopologicalSpace.Opens.ext <| by simp
#align prime_spectrum.basic_open_one PrimeSpectrum.basicOpen_one

@[simp]
theorem basicOpen_zero : basicOpen (0 : R) = ⊥ :=
  TopologicalSpace.Opens.ext <| by simp
#align prime_spectrum.basic_open_zero PrimeSpectrum.basicOpen_zero

theorem basicOpen_le_basicOpen_iff (f g : R) :
    basicOpen f ≤ basicOpen g ↔ f ∈ (Ideal.span ({g} : Set R)).radical := by
  rw [← SetLike.coe_subset_coe, basic_open_eq_zero_locus_compl, basic_open_eq_zero_locus_compl,
    Set.compl_subset_compl, zero_locus_subset_zero_locus_singleton_iff]
#align prime_spectrum.basic_open_le_basic_open_iff PrimeSpectrum.basicOpen_le_basicOpen_iff

theorem basicOpen_mul (f g : R) : basicOpen (f * g) = basicOpen f ⊓ basicOpen g :=
  TopologicalSpace.Opens.ext <| by simp [zero_locus_singleton_mul]
#align prime_spectrum.basic_open_mul PrimeSpectrum.basicOpen_mul

theorem basicOpen_mul_le_left (f g : R) : basicOpen (f * g) ≤ basicOpen f :=
  by
  rw [basic_open_mul f g]
  exact inf_le_left
#align prime_spectrum.basic_open_mul_le_left PrimeSpectrum.basicOpen_mul_le_left

theorem basicOpen_mul_le_right (f g : R) : basicOpen (f * g) ≤ basicOpen g :=
  by
  rw [basic_open_mul f g]
  exact inf_le_right
#align prime_spectrum.basic_open_mul_le_right PrimeSpectrum.basicOpen_mul_le_right

@[simp]
theorem basicOpen_pow (f : R) (n : ℕ) (hn : 0 < n) : basicOpen (f ^ n) = basicOpen f :=
  TopologicalSpace.Opens.ext <| by simpa using zero_locus_singleton_pow f n hn
#align prime_spectrum.basic_open_pow PrimeSpectrum.basicOpen_pow

theorem isTopologicalBasis_basic_opens :
    TopologicalSpace.IsTopologicalBasis
      (Set.range fun r : R => (basicOpen r : Set (PrimeSpectrum R))) :=
  by
  apply TopologicalSpace.isTopologicalBasis_of_open_of_nhds
  · rintro _ ⟨r, rfl⟩
    exact is_open_basic_open
  · rintro p U hp ⟨s, hs⟩
    rw [← compl_compl U, Set.mem_compl_iff, ← hs, mem_zero_locus, Set.not_subset] at hp
    obtain ⟨f, hfs, hfp⟩ := hp
    refine' ⟨basic_open f, ⟨f, rfl⟩, hfp, _⟩
    rw [← Set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl]
    exact zero_locus_anti_mono (set.singleton_subset_iff.mpr hfs)
#align prime_spectrum.is_topological_basis_basic_opens PrimeSpectrum.isTopologicalBasis_basic_opens

theorem isBasis_basic_opens : TopologicalSpace.Opens.IsBasis (Set.range (@basicOpen R _)) :=
  by
  unfold TopologicalSpace.Opens.IsBasis
  convert is_topological_basis_basic_opens
  rw [← Set.range_comp]
#align prime_spectrum.is_basis_basic_opens PrimeSpectrum.isBasis_basic_opens

theorem isCompact_basicOpen (f : R) : IsCompact (basicOpen f : Set (PrimeSpectrum R)) :=
  isCompact_of_finite_subfamily_closed fun ι Z hZc hZ =>
    by
    let I : ι → Ideal R := fun i => vanishing_ideal (Z i)
    have hI : ∀ i, Z i = zero_locus (I i) := fun i => by
      simpa only [zero_locus_vanishing_ideal_eq_closure] using (hZc i).closure_eq.symm
    rw [basic_open_eq_zero_locus_compl f, Set.inter_comm, ← Set.diff_eq, Set.diff_eq_empty,
      funext hI, ← zero_locus_supr] at hZ
    obtain ⟨n, hn⟩ : f ∈ (⨆ i : ι, I i).radical :=
      by
      rw [← vanishing_ideal_zero_locus_eq_radical]
      apply vanishing_ideal_anti_mono hZ
      exact subset_vanishing_ideal_zero_locus {f} (Set.mem_singleton f)
    rcases Submodule.exists_finset_of_mem_supᵢ I hn with ⟨s, hs⟩
    use s
    -- Using simp_rw here, because `hI` and `zero_locus_supr` need to be applied underneath binders
    simp_rw [basic_open_eq_zero_locus_compl f, Set.inter_comm (zero_locus {f}ᶜ), ← Set.diff_eq,
      Set.diff_eq_empty, hI, ← zero_locus_supr]
    rw [← zero_locus_radical]
    -- this one can't be in `simp_rw` because it would loop
    apply zero_locus_anti_mono
    rw [Set.singleton_subset_iff]
    exact ⟨n, hs⟩
#align prime_spectrum.is_compact_basic_open PrimeSpectrum.isCompact_basicOpen

@[simp]
theorem basicOpen_eq_bot_iff (f : R) : basicOpen f = ⊥ ↔ IsNilpotent f :=
  by
  rw [← TopologicalSpace.Opens.coe_inj, basic_open_eq_zero_locus_compl]
  simp only [Set.eq_univ_iff_forall, Set.singleton_subset_iff, TopologicalSpace.Opens.coe_bot,
    nilpotent_iff_mem_prime, Set.compl_empty_iff, mem_zero_locus, SetLike.mem_coe]
  exact ⟨fun h I hI => h ⟨I, hI⟩, fun h ⟨I, hI⟩ => h I hI⟩
#align prime_spectrum.basic_open_eq_bot_iff PrimeSpectrum.basicOpen_eq_bot_iff

theorem localization_away_comap_range (S : Type v) [CommRing S] [Algebra R S] (r : R)
    [IsLocalization.Away r S] : Set.range (comap (algebraMap R S)) = basicOpen r :=
  by
  rw [localization_comap_range S (Submonoid.powers r)]
  ext
  simp only [mem_zero_locus, basic_open_eq_zero_locus_compl, SetLike.mem_coe, Set.mem_setOf_eq,
    Set.singleton_subset_iff, Set.mem_compl_iff, disjoint_iff_inf_le]
  constructor
  · intro h₁ h₂
    exact h₁ ⟨Submonoid.mem_powers r, h₂⟩
  · rintro h₁ _ ⟨⟨n, rfl⟩, h₃⟩
    exact h₁ (x.2.mem_of_pow_mem _ h₃)
#align prime_spectrum.localization_away_comap_range PrimeSpectrum.localization_away_comap_range

theorem localization_away_openEmbedding (S : Type v) [CommRing S] [Algebra R S] (r : R)
    [IsLocalization.Away r S] : OpenEmbedding (comap (algebraMap R S)) :=
  { toEmbedding := localization_comap_embedding S (Submonoid.powers r)
    open_range := by
      rw [localization_away_comap_range S r]
      exact is_open_basic_open }
#align prime_spectrum.localization_away_open_embedding PrimeSpectrum.localization_away_openEmbedding

end BasicOpen

/-- The prime spectrum of a commutative ring is a compact topological space. -/
instance : CompactSpace (PrimeSpectrum R)
    where isCompact_univ := by
    convert is_compact_basic_open (1 : R)
    rw [basic_open_one]
    rfl

section Order

/-!
## The specialization order

We endow `prime_spectrum R` with a partial order, where `x ≤ y` if and only if `y ∈ closure {x}`.
-/

instance : PartialOrder (PrimeSpectrum R) :=
  PartialOrder.lift asIdeal ext

@[simp]
theorem asIdeal_le_asIdeal (x y : PrimeSpectrum R) : x.asIdeal ≤ y.asIdeal ↔ x ≤ y :=
  Iff.rfl
#align prime_spectrum.as_ideal_le_as_ideal PrimeSpectrum.asIdeal_le_asIdeal

@[simp]
theorem asIdeal_lt_asIdeal (x y : PrimeSpectrum R) : x.asIdeal < y.asIdeal ↔ x < y :=
  Iff.rfl
#align prime_spectrum.as_ideal_lt_as_ideal PrimeSpectrum.asIdeal_lt_asIdeal

theorem le_iff_mem_closure (x y : PrimeSpectrum R) :
    x ≤ y ↔ y ∈ closure ({x} : Set (PrimeSpectrum R)) := by
  rw [← as_ideal_le_as_ideal, ← zero_locus_vanishing_ideal_eq_closure, mem_zero_locus,
    vanishing_ideal_singleton, SetLike.coe_subset_coe]
#align prime_spectrum.le_iff_mem_closure PrimeSpectrum.le_iff_mem_closure

theorem le_iff_specializes (x y : PrimeSpectrum R) : x ≤ y ↔ x ⤳ y :=
  (le_iff_mem_closure x y).trans specializes_iff_mem_closure.symm
#align prime_spectrum.le_iff_specializes PrimeSpectrum.le_iff_specializes

/-- `nhds` as an order embedding. -/
@[simps (config := { fullyApplied := true })]
def nhdsOrderEmbedding : PrimeSpectrum R ↪o Filter (PrimeSpectrum R) :=
  OrderEmbedding.ofMapLEIff nhds fun a b => (le_iff_specializes a b).symm
#align prime_spectrum.nhds_order_embedding PrimeSpectrum.nhdsOrderEmbedding

instance : T0Space (PrimeSpectrum R) :=
  ⟨nhdsOrderEmbedding.Injective⟩

instance [IsDomain R] : OrderBot (PrimeSpectrum R)
    where
  bot := ⟨⊥, Ideal.bot_prime⟩
  bot_le I := @bot_le _ _ _ I.asIdeal

instance {R : Type _} [Field R] : Unique (PrimeSpectrum R)
    where
  default := ⊥
  uniq x := ext _ _ ((IsSimpleOrder.eq_bot_or_eq_top _).resolve_right x.2.ne_top)

end Order

/-- If `x` specializes to `y`, then there is a natural map from the localization of `y` to the
localization of `x`. -/
def localizationMapOfSpecializes {x y : PrimeSpectrum R} (h : x ⤳ y) :
    Localization.AtPrime y.asIdeal →+* Localization.AtPrime x.asIdeal :=
  @IsLocalization.lift _ _ _ _ _ _ _ _ Localization.isLocalization
    (algebraMap R (Localization.AtPrime x.asIdeal))
    (by
      rintro ⟨a, ha⟩
      rw [← PrimeSpectrum.le_iff_specializes, ← as_ideal_le_as_ideal, ← SetLike.coe_subset_coe, ←
        Set.compl_subset_compl] at h
      exact (IsLocalization.map_units _ ⟨a, show a ∈ x.as_ideal.prime_compl from h ha⟩ : _))
#align prime_spectrum.localization_map_of_specializes PrimeSpectrum.localizationMapOfSpecializes

end PrimeSpectrum

namespace LocalRing

variable [LocalRing R]

/-- The closed point in the prime spectrum of a local ring. -/
def closedPoint : PrimeSpectrum R :=
  ⟨maximalIdeal R, (maximalIdeal.isMaximal R).IsPrime⟩
#align local_ring.closed_point LocalRing.closedPoint

variable {R}

theorem isLocalRingHom_iff_comap_closedPoint {S : Type v} [CommRing S] [LocalRing S] (f : R →+* S) :
    IsLocalRingHom f ↔ PrimeSpectrum.comap f (closedPoint S) = closedPoint R :=
  by
  rw [(local_hom_tfae f).out 0 4, PrimeSpectrum.ext_iff]
  rfl
#align local_ring.is_local_ring_hom_iff_comap_closed_point LocalRing.isLocalRingHom_iff_comap_closedPoint

@[simp]
theorem comap_closedPoint {S : Type v} [CommRing S] [LocalRing S] (f : R →+* S) [IsLocalRingHom f] :
    PrimeSpectrum.comap f (closedPoint S) = closedPoint R :=
  (isLocalRingHom_iff_comap_closedPoint f).mp inferInstance
#align local_ring.comap_closed_point LocalRing.comap_closedPoint

theorem specializes_closedPoint (x : PrimeSpectrum R) : x ⤳ closedPoint R :=
  (PrimeSpectrum.le_iff_specializes _ _).mp (LocalRing.le_maximalIdeal x.2.1)
#align local_ring.specializes_closed_point LocalRing.specializes_closedPoint

theorem closedPoint_mem_iff (U : TopologicalSpace.Opens <| PrimeSpectrum R) :
    closedPoint R ∈ U ↔ U = ⊤ := by
  constructor
  · rw [eq_top_iff]
    exact fun h x _ => (specializes_closed_point x).mem_open U.2 h
  · rintro rfl
    trivial
#align local_ring.closed_point_mem_iff LocalRing.closedPoint_mem_iff

@[simp]
theorem PrimeSpectrum.comap_residue (x : PrimeSpectrum (ResidueField R)) :
    PrimeSpectrum.comap (residue R) x = closedPoint R :=
  by
  rw [Subsingleton.elim x ⊥]
  ext1
  exact Ideal.mk_ker
#align prime_spectrum.comap_residue PrimeSpectrum.comap_residue

end LocalRing


/- -----------------------------------------------------------------------
Natural transformations.
----------------------------------------------------------------------- -/

import .s2_functors

namespace qp

open stdaux

universe variables ℓobj₁ ℓhom₁ ℓobj₂ ℓhom₂ ℓobj₃ ℓhom₃ ℓobj₄ ℓhom₄

/-! #brief A natural transformation between functors.
-/
structure NatTrans
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (F G : Fun C D)
    : Type (max ℓobj₁ ℓhom₁ ℓobj₂ ℓhom₂)
:= (com : ∀ (x : C^.obj), D^.hom (F^.obj x) (G^.obj x))
   (natural : ∀ {x y : C^.obj} (f : C^.hom x y)
              , D^.circ (com y) (F^.hom f)
                 = D^.circ (G^.hom f) (com x))

-- A natural transformation.
-- \rightarrowtail
notation F `↣` G := NatTrans F G

/-! #brief Equality of natural transformations.
-/
theorem NatTrans.eq
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    : ∀ {η₁ η₂ : NatTrans F₁ F₂}
         (ω : η₁^.com = η₂^.com)
      , η₁ = η₂
| (NatTrans.mk com ω₁) (NatTrans.mk .(com) ω₂) (eq.refl .(com)) := rfl

/-! #brief Heterogeneous equality of natural transformations.
-/
theorem NatTrans.heq
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    : ∀ {F₁₁ F₁₂ F₂₁ F₂₂ : Fun C D}
         {η₁ : NatTrans F₁₁ F₁₂}
         {η₂ : NatTrans F₂₁ F₂₂}
         (ω₁ : F₁₁ = F₂₁)
         (ω₂ : F₁₂ = F₂₂)
         (ωcom : F₁₁ = F₂₁ → F₁₂ = F₂₂ → η₁^.com == η₂^.com)
       , η₁ == η₂
| F₁ F₂ .(F₁) .(F₂) η₁ η₂ (eq.refl .(F₁)) (eq.refl .(F₂)) ωcom
:= heq_of_eq (NatTrans.eq (eq_of_heq (ωcom rfl rfl)))

/-! #brief Congruence for NatTrans.com
-/
theorem NatTrans.congr_com
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    : ∀ {η₁ η₂ : NatTrans F₁ F₂}
        (ωη : η₁ = η₂)
        {c : C^.obj}
      , η₁^.com c = η₂^.com c
| η .(η) (eq.refl .(η)) c := rfl

/- -----------------------------------------------------------------------
Natural transformations are morphisms of functors.
----------------------------------------------------------------------- -/

/-! #brief The identity natural transformation.
-/
definition NatTrans.id {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun C D)
    : NatTrans F F
:= { com := λ x, D^.id (F^.obj x)
   , natural := λ x y f, by rw [D^.circ_id_left, D^.circ_id_right]
   }

/-! #brief Composition of natural transformations.
-/
definition NatTrans.comp {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ F₃ : Fun C D}
    (η₂₃ : NatTrans F₂ F₃)
    (η₁₂ : NatTrans F₁ F₂)
    : NatTrans F₁ F₃
:= { com := λ x, D^.circ (η₂₃^.com x) (η₁₂^.com x)
   , natural := λ x y f
                , by calc η₂₃^.com y ∘∘ η₁₂^.com y ∘∘ F₁^.hom f
                              = η₂₃^.com y ∘∘ (η₁₂^.com y ∘∘ F₁^.hom f) : by rw D^.circ_assoc
                          ... = η₂₃^.com y ∘∘ (F₂^.hom f ∘∘ η₁₂^.com x) : by rw η₁₂^.natural
                          ... = (η₂₃^.com y ∘∘ F₂^.hom f) ∘∘ η₁₂^.com x : by rw D^.circ_assoc
                          ... = (F₃^.hom f ∘∘ η₂₃^.com x) ∘∘ η₁₂^.com x : by rw η₂₃^.natural
                          ... = F₃^.hom f ∘∘ (η₂₃^.com x ∘∘ η₁₂^.com x) : by rw D^.circ_assoc
   }

-- Composition of natural transformations.
-- \Diamond\Diamond
infixl ` ◇◇ ` : 150 := NatTrans.comp

/-! #brief Composition of natural transformations is associative.
-/
theorem NatTrans.comp_assoc {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (F₁ F₂ F₃ F₄ : Fun C D)
    (η₃₄ : NatTrans F₃ F₄)
    (η₂₃ : NatTrans F₂ F₃)
    (η₁₂ : NatTrans F₁ F₂)
    : NatTrans.comp η₃₄ (NatTrans.comp η₂₃ η₁₂)
       = NatTrans.comp (NatTrans.comp η₃₄ η₂₃) η₁₂
:= NatTrans.eq (funext (λ c, D^.circ_assoc))

/-! #brief Left-identity for composition of natural transformation.
-/
theorem NatTrans.comp_id_left {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    (η : NatTrans F₁ F₂)
    : NatTrans.comp (NatTrans.id F₂) η = η
:= NatTrans.eq (funext (λ c, D^.circ_id_left))

/-! #brief Right-identity for composition of natural transformation.
-/
theorem NatTrans.comp_id_right {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    (η : NatTrans F₁ F₂)
    : NatTrans.comp η (NatTrans.id F₁) = η
:= NatTrans.eq (funext (λ c, D^.circ_id_right))

/-! #brief The casting natural transformation.
-/
definition NatTrans.cast {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    : ∀ {F₁ F₂ : Fun C D}
        (ωF : F₁ = F₂)
      , NatTrans F₁ F₂
| F .(F) (eq.refl .(F)) := NatTrans.id F

/-! #brief The casting transformation is the identity.
-/
theorem NatTrans.simp_cast {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    : ∀ {F₁ F₂ : Fun C D}
        {ωF : F₁ = F₂}
      , NatTrans.cast ωF == NatTrans.id F₁
| F .(F) (eq.refl .(F)) := heq.refl _

/-! #brief The casting transformation has identity components.
-/
theorem NatTrans.cast.com {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    : ∀ {F₁ F₂ : Fun C D}
        {ωF : F₁ = F₂}
        {c : C^.obj}
      , (NatTrans.cast ωF)^.com c = cast_hom (by rw ωF)
| F .(F) (eq.refl .(F)) c := rfl

/-! #brief Composition of casting natural transformations.
-/
theorem NatTrans.comp_cast {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    : ∀ {F₁ F₂ F₃ : Fun C D}
        {ωF₁₂ : F₁ = F₂}
        {ωF₂₃ : F₂ = F₃}
      , NatTrans.comp (NatTrans.cast ωF₂₃) (NatTrans.cast ωF₁₂)
         = NatTrans.cast (eq.trans ωF₁₂ ωF₂₃)
| F .(F) .(F) (eq.refl .(F)) (eq.refl .(F))
:= NatTrans.eq (funext (λ c, D^.circ_id_left))

/-! #brief Casting natural transformations are just identities.
-/
theorem NatTrans.cast_rfl {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F : Fun C D}
    : NatTrans.cast (eq.refl F) = NatTrans.id F
:= rfl

/- -----------------------------------------------------------------------
Constant transformations.
----------------------------------------------------------------------- -/

/-! #brief A constant transformation.
-/
definition ConstTrans (C : Cat.{ℓobj₁ ℓhom₁}) {D : Cat.{ℓobj₂ ℓhom₂}}
    {d₁ d₂ : D^.obj} (h : D^.hom d₁ d₂)
    : NatTrans (ConstFun C d₁) (ConstFun C d₂)
:= { com := λ c, h
   , natural := λ c₁ c₂ f, eq.trans D^.circ_id_right (eq.symm D^.circ_id_left)
   }

/- -----------------------------------------------------------------------
Functor categories.
----------------------------------------------------------------------- -/

/-! #brief A functor category.
-/
definition FunCat (C : Cat.{ℓobj₁ ℓhom₁}) (D : Cat.{ℓobj₂ ℓhom₂})
    : Cat
:= { obj := Fun C D
   , hom := NatTrans
   , id := NatTrans.id
   , circ := @NatTrans.comp C D
   , circ_assoc := @NatTrans.comp_assoc C D
   , circ_id_left := @NatTrans.comp_id_left C D
   , circ_id_right := @NatTrans.comp_id_right C D
   }

/-! #brief A presheaf category.
-/
definition PreShCat (C : Cat.{ℓobj₁ ℓhom₁})
    : Cat.{(max ℓobj₁ (ℓhom₁ + 1)) ((max ℓobj₁ (ℓhom₁ + 1)) + 1)}
:= FunCat (OpCat C) LeanCat.{ℓhom₁}

/-! #brief Functor categories have pointwise final objects.
-/
definition FunCat.HasFinal {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasFinal : HasFinal D]
    : HasFinal (FunCat C D)
:= HasFinal.show (ConstFun C (final D))
    (λ F, { com := λ c, final_hom (F^.obj c)
          , natural
             := λ c₁ c₂ f
                , eq.trans (final_hom.uniq D) (eq.symm D^.circ_id_left)
          })
    (λ F η, NatTrans.eq (funext (λ c, final_hom.uniq D)))

/-! #brief Functor categories have pointwise initial objects.
-/
definition FunCat.HasInit {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasInit : HasInit D]
    : HasInit (FunCat C D)
:= HasFinal.show (ConstFun C (init D))
    (λ F, { com := λ c, init_hom (F^.obj c)
          , natural
             := λ c₁ c₂ f
                , eq.trans D^.circ_id_right (eq.symm (init_hom.uniq D))
          })
    (λ F η, NatTrans.eq (funext (λ c, init_hom.uniq D)))

/- -----------------------------------------------------------------------
Swapping the arguments of functors into functor categories.
----------------------------------------------------------------------- -/

/-! #brief Swap the arguments of a functor.
-/
definition Fun.swap.obj {A : Cat.{ℓobj₁ ℓhom₁}} {B : Cat.{ℓobj₂ ℓhom₂}} {C : Cat.{ℓobj₃ ℓhom₃}}
    (F : Fun A (FunCat B C))
    (b : B^.obj)
    : Fun A C
:= { obj := λ a, (F^.obj a)^.obj b
   , hom := λ a₁ a₂ f, (F^.hom f)^.com b
   , hom_id := λ x, begin
                      rw F^.hom_id,
                      trivial
                    end
   , hom_circ := λ x y z g f, begin rw F^.hom_circ, trivial end
   }

/-! #brief Swap the arguments of a natural transformation.
-/
definition Fun.swap.hom {A : Cat.{ℓobj₁ ℓhom₁}} {B : Cat.{ℓobj₂ ℓhom₂}} {C : Cat.{ℓobj₃ ℓhom₃}}
    (F : Fun A (FunCat B C))
    (b₁ b₂ : B^.obj) (f : B^.hom b₁ b₂)
    : NatTrans (Fun.swap.obj F b₁) (Fun.swap.obj F b₂)
:= { com := λ a, (F^.obj a)^.hom f
   , natural := λ x y g, eq.symm ((F^.hom g)^.natural f)
   }

/-! #brief Swap the arguments.
-/
definition Fun.swap {A : Cat.{ℓobj₁ ℓhom₁}} {B : Cat.{ℓobj₂ ℓhom₂}} {C : Cat.{ℓobj₃ ℓhom₃}}
    (F : Fun A (FunCat B C))
    : Fun B (FunCat A C)
:= { obj := Fun.swap.obj F
   , hom := Fun.swap.hom F
   , hom_id := λ b, NatTrans.eq (funext (λ a, (F^.obj a)^.hom_id))
   , hom_circ := λ b₁ b₂ b₃ g f, NatTrans.eq (funext (λ a, (F^.obj a)^.hom_circ))
   }

/- -----------------------------------------------------------------------
Natural isomorphisms.
----------------------------------------------------------------------- -/

/-! #brief A natural isomorphism between two functors.
-/
definition NatIso {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    (η₁₂ : NatTrans F₁ F₂)
    (η₂₁ : NatTrans F₂ F₁)
    : Prop
:= @Iso (FunCat C D) F₁ F₂ η₁₂ η₂₁

/-! #brief The identity natural transformation is a natural isomorphism.
-/
theorem NatIso.id {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F : Fun C D}
    : NatIso (NatTrans.id F) (NatTrans.id F)
:= Cat.id.Iso F

/-! #brief The composition of two natural isomorphisms is a natural iso.
-/
theorem NatIso.comp {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ F₃ : Fun C D}
    {η₂₃ : NatTrans F₂ F₃} {η₂₃' : NatTrans F₃ F₂} (iso₂₃ : NatIso η₂₃ η₂₃')
    {η₁₂ : NatTrans F₁ F₂} {η₁₂' : NatTrans F₂ F₁} (iso₁₂ : NatIso η₁₂ η₁₂')
    : NatIso (NatTrans.comp η₂₃ η₁₂) (NatTrans.comp η₁₂' η₂₃')
:= Cat.circ.Iso iso₂₃ iso₁₂

/-! #brief The components of a natural isomorphism are isomorphisms.
-/
theorem NatIso.com {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η₁₂ : NatTrans F₁ F₂}
    {η₂₁ : NatTrans F₂ F₁}
    (iso : NatIso η₁₂ η₂₁)
    (c : C^.obj)
    : Iso (η₁₂^.com c) (η₂₁^.com c)
:= { id₁ := congr_arg (λ η, NatTrans.com η c) iso^.id₁
   , id₂ := congr_arg (λ η, NatTrans.com η c) iso^.id₂
   }

/-! #brief A natural transformation whose components are isos is a natural iso.
-/
theorem NatTrans.Iso_on_com {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η₁₂ : NatTrans F₁ F₂}
    {η₂₁ : NatTrans F₂ F₁}
    (ω : ∀ (c : C^.obj), Iso (η₁₂^.com c) (η₂₁^.com c))
    : NatIso η₁₂ η₂₁
:= { id₁ := NatTrans.eq (funext (λ c, (ω c)^.id₁))
   , id₂ := NatTrans.eq (funext (λ c, (ω c)^.id₂))
   }

/- -----------------------------------------------------------------------
Opposite transformations.
----------------------------------------------------------------------- -/

/-! #brief An opposite transformation.
-/
definition OpTrans {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    (η : NatTrans F₁ F₂)
    : NatTrans (OpFun F₂) (OpFun F₁)
:= { com := λ x, η^.com x
   , natural := λ x y f, eq.symm (η^.natural f)
   }

/-! #brief Opposites of natural isos are again natural isos.
-/
definition OpNatIso {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η₁₂ : NatTrans F₁ F₂}
    {η₂₁ : NatTrans F₂ F₁}
    (η_iso : NatIso η₁₂ η₂₁)
    : NatIso (OpTrans η₁₂) (OpTrans η₂₁)
:= { id₁ := begin
              apply NatTrans.eq, apply funext, intro c,
              apply NatTrans.congr_com η_iso^.id₂
            end
   , id₂ := begin
              apply NatTrans.eq, apply funext, intro c,
              apply NatTrans.congr_com η_iso^.id₁
            end
   }

/- -----------------------------------------------------------------------
Monics.
----------------------------------------------------------------------- -/

/-! #brief Monic natural transformations have monic components.
-/
theorem NatTrans.com.Monic {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η : NatTrans F₁ F₂}
    (η_Monic : @Monic (FunCat C D) F₁ F₂ η)
    (c : C^.obj)
    : Monic (η^.com c)
:= Monic.show (λ d f₁ f₂ ω
               , begin exact sorry end)

/- -----------------------------------------------------------------------
Whisker composition of natural transformations.
----------------------------------------------------------------------- -/

/-! #brief Left whisker composition.
-/
definition NatTrans.whisk_left {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    (G : Fun C D)
    {F₁ F₂ : Fun B C}
    (η : NatTrans F₁ F₂)
    : NatTrans (Fun.comp G F₁) (Fun.comp G F₂)
:= { com := λ b, G^.hom (η^.com b)
   , natural := λ b₁ b₂ f
                , by calc G^.hom (η^.com b₂) ∘∘ (G □□ F₁)^.hom f
                              = G^.hom (η^.com b₂ ∘∘ F₁^.hom f)        : eq.symm G^.hom_circ
                          ... = G^.hom (F₂^.hom f ∘∘ η^.com b₁)        : by rw η^.natural
                          ... = (G □□ F₂)^.hom f ∘∘ G^.hom (η^.com b₁) : G^.hom_circ
   }

-- Left whisker composition.
-- \Box\Diamond
infixr ` □◇ ` : 150 := NatTrans.whisk_left

/-! #brief Left whisker composition and identity functors.
-/
theorem NatTrans.whisk_left.id_left {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η : NatTrans F₁ F₂}
    : NatTrans.whisk_left (Fun.id D) η == η
:= NatTrans.heq Fun.comp_id_left Fun.comp_id_left
    (λ ω₁ ω₂, heq.refl _)

/-! #brief Left whisker composition and composition of functors.
-/
definition NatTrans.whisk_left.comp_left
    {A : Cat.{ℓobj₁ ℓhom₁}} {B : Cat.{ℓobj₂ ℓhom₂}} {C : Cat.{ℓobj₃ ℓhom₃}} {D : Cat.{ℓobj₄ ℓhom₄}}
    {H : Fun C D}
    {G : Fun B C}
    {F₁ F₂ : Fun A B}
    {η : NatTrans F₁ F₂}
    : NatTrans.whisk_left (Fun.comp H G) η == NatTrans.whisk_left H (NatTrans.whisk_left G η)
:= NatTrans.heq Fun.comp_assoc Fun.comp_assoc
    (λ ω₁ ω₂, heq.refl _)

/-! #brief Left whisker composition and identity natural transformations.
-/
theorem NatTrans.whisk_left.id_right {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G : Fun C D}
    {F : Fun B C}
    : NatTrans.whisk_left G (NatTrans.id F) = NatTrans.id (Fun.comp G F)
:= NatTrans.eq (funext (λ b, G^.hom_id))

/-! #brief Left whisker composition and composition of natural transformations.
-/
theorem NatTrans.whisk_left.comp_right {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G : Fun C D}
    {F₁ F₂ F₃ : Fun B C}
    {η₂₃ : NatTrans F₂ F₃}
    {η₁₂ : NatTrans F₁ F₂}
    : NatTrans.whisk_left G (NatTrans.comp η₂₃ η₁₂)
       = NatTrans.comp (NatTrans.whisk_left G η₂₃) (NatTrans.whisk_left G η₁₂)
:= NatTrans.eq (funext (λ b, G^.hom_circ))

/-! #brief Left whisker composition preserves natural isomorphisms.
-/
theorem NatTrans.whisk_left.NatIso {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    (G : Fun C D)
    {F₁ F₂ : Fun B C}
    {η₁₂ : NatTrans F₁ F₂}
    {η₂₁ : NatTrans F₂ F₁}
    (iso : NatIso η₁₂ η₂₁)
    : NatIso (NatTrans.whisk_left G η₁₂) (NatTrans.whisk_left G η₂₁)
:= NatTrans.Iso_on_com (λ b, Fun.preserves_Iso G (NatIso.com iso b))

/-! #brief Right whisker composition.
-/
definition NatTrans.whisk_right {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G₁ G₂ : Fun C D}
    (η : NatTrans G₁ G₂)
    (F : Fun B C)
    : NatTrans (Fun.comp G₁ F) (Fun.comp G₂ F)
:= { com := λ b, η^.com (F^.obj b)
   , natural := λ b₁ b₂ f, η^.natural _
   }

-- Right whisker composition.
-- \Diamond\Box
infixl ` ◇□ ` : 150 := NatTrans.whisk_right

/-! #brief Right whisker composition and identity functors.
-/
theorem NatTrans.whisk_right_id_right {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ F₂ : Fun C D}
    {η : NatTrans F₁ F₂}
    : NatTrans.whisk_right η (Fun.id C) == η
:= NatTrans.heq Fun.comp_id_right Fun.comp_id_right
    (λ ω₁ ω₂, heq.refl _)

/-! #brief Right whisker composition and composition of functors.
-/
definition NatTrans.whisk_right.comp_right
    {A : Cat.{ℓobj₁ ℓhom₁}} {B : Cat.{ℓobj₂ ℓhom₂}} {C : Cat.{ℓobj₃ ℓhom₃}} {D : Cat.{ℓobj₄ ℓhom₄}}
    {F₁ F₂ : Fun C D}
    {η : NatTrans F₁ F₂}
    {H : Fun B C}
    {G : Fun A B}
    : NatTrans.whisk_right η (Fun.comp H G) == NatTrans.whisk_right (NatTrans.whisk_right η H) G
:= NatTrans.heq Fun.comp_assoc Fun.comp_assoc
    (λ ω₁ ω₂, heq.refl _)

/-! #brief Right whisker composition and identity natural transformations.
-/
theorem NatTrans.whisk_right.id_left {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G : Fun C D}
    {F : Fun B C}
    : NatTrans.whisk_right (NatTrans.id G) F = NatTrans.id (Fun.comp G F)
:= NatTrans.eq (funext (λ b, rfl))

/-! #brief Right whisker composition and composition of natural transformations.
-/
theorem NatTrans.whisk_right.comp_left {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G : Fun B C}
    {F₁ F₂ F₃ : Fun C D}
    {η₂₃ : NatTrans F₂ F₃}
    {η₁₂ : NatTrans F₁ F₂}
    : NatTrans.whisk_right (NatTrans.comp η₂₃ η₁₂) G
       = NatTrans.comp (NatTrans.whisk_right η₂₃ G) (NatTrans.whisk_right η₁₂ G)
:= NatTrans.eq (funext (λ b, rfl))

/-! #brief Right whisker composition preserves natural isomorphisms.
-/
theorem NatTrans.whisk_right.NatIso {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    {G₁ G₂ : Fun C D}
    {η₁₂ : NatTrans G₁ G₂}
    {η₂₁ : NatTrans G₂ G₁}
    (iso : NatIso η₁₂ η₂₁)
    (F : Fun B C)
    : NatIso (NatTrans.whisk_right η₁₂ F) (NatTrans.whisk_right η₂₁ F)
:= NatTrans.Iso_on_com (λ b, NatIso.com iso (F^.obj b))

/- -----------------------------------------------------------------------
Adjoint functors.
----------------------------------------------------------------------- -/

/-! #brief An adjunction between two functors.
-/
structure Adj
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun C D)
    (R : Fun D C)
  : Type (max ℓobj₁ ℓhom₁ ℓobj₂ ℓhom₂)
  := mk :: (counit : NatTrans (Fun.comp L R) (Fun.id D))
           (unit : NatTrans (Fun.id C) (Fun.comp R L))
           (id_left : ∀ {c : C^.obj}, counit^.com (L^.obj c) ∘∘ L^.hom (unit^.com c) = D^.id (L^.obj c))
           (id_right : ∀ {d : D^.obj}, R^.hom (counit^.com d) ∘∘ unit^.com (R^.obj d) = C^.id (R^.obj d))

-- An adjunction of functors.
-- \dashv
notation L ` ⊣ ` R := Adj L R

/-! #brief The right adjoint of a hom.
-/
definition Adj.right_adj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} (f : D^.hom (L^.obj c) d)
    : C^.hom c (R^.obj d)
:= R^.hom f ∘∘ adj^.unit^.com c

/-! #brief The left adjoint of a hom.
-/
definition Adj.left_adj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} (f : C^.hom c (R^.obj d))
    : D^.hom (L^.obj c) d
:= adj^.counit^.com d ∘∘ L^.hom f

/-! #brief right_adj and left_adj are inverses of one another.
-/
theorem Adj.right_adj_left_adj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} {f : C^.hom c (R^.obj d)}
    : adj^.right_adj (adj^.left_adj f) = f
:= by calc adj^.right_adj (adj^.left_adj f)
               = R^.hom (adj^.counit^.com d ∘∘ L^.hom f) ∘∘ adj^.unit^.com c            : rfl
           ... = R^.hom (adj^.counit^.com d) ∘∘ R^.hom (L^.hom f) ∘∘ adj^.unit^.com c   : by rw R^.hom_circ
           ... = R^.hom (adj^.counit^.com d) ∘∘ (R^.hom (L^.hom f) ∘∘ adj^.unit^.com c) : by rw C^.circ_assoc
           ... = R^.hom (adj^.counit^.com d) ∘∘ ((R □□ L)^.hom f ∘∘ adj^.unit^.com c)   : rfl
           ... = R^.hom (adj^.counit^.com d) ∘∘ (adj^.unit^.com (R^.obj d) ∘∘ f)        : congr_arg (λ q, R^.hom (adj^.counit^.com d) ∘∘ q) (eq.symm (adj^.unit^.natural _))
           ... = R^.hom (adj^.counit^.com d) ∘∘ adj^.unit^.com (R^.obj d) ∘∘ f          : C^.circ_assoc
           ... = ⟨⟨R^.obj d⟩⟩ ∘∘ f                                                      : congr_arg (λ q, q ∘∘ f) adj^.id_right
           ... = f                                                                      : C^.circ_id_left

/-! #brief left_adj and right_adj are inverses of one another.
-/
theorem Adj.left_adj_right_adj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} {f : D^.hom (L^.obj c) d}
    : adj^.left_adj (adj^.right_adj f) = f
:= by calc adj^.left_adj (adj^.right_adj f)
               = adj^.counit^.com d ∘∘ L^.hom (R^.hom f ∘∘ adj^.unit^.com c) : rfl
           ... = adj^.counit^.com d ∘∘ (L^.hom (R^.hom f) ∘∘ L^.hom (adj^.unit^.com c)) : congr_arg (λ q, adj^.counit^.com d ∘∘ q) L^.hom_circ
           ... = adj^.counit^.com d ∘∘ ((L □□ R)^.hom f ∘∘ L^.hom (adj^.unit^.com c))   : rfl
           ... = adj^.counit^.com d ∘∘ (L □□ R)^.hom f ∘∘ L^.hom (adj^.unit^.com c)     : by rw D^.circ_assoc
           ... = f ∘∘ adj^.counit^.com (L^.obj c) ∘∘ L^.hom (adj^.unit^.com c)          : congr_arg (λ q, q ∘∘ L^.hom (adj^.unit^.com c)) (adj^.counit^.natural _)
           ... = f ∘∘ (adj^.counit^.com (L^.obj c) ∘∘ L^.hom (adj^.unit^.com c))        : by rw D^.circ_assoc
           ... = f ∘∘ ⟨⟨L^.obj c⟩⟩                                                      : congr_arg (λ q, f ∘∘ q) adj^.id_left
           ... = f                                                                      : D^.circ_id_right

/-! #brief left_adj is injective.
-/
theorem Adj.left_adj.inj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} {f₁ f₂ : C^.hom c (R^.obj d)}
    (ω : Adj.left_adj adj f₁ = Adj.left_adj adj f₂)
    : f₁ = f₂
:= begin
     apply eq.trans (eq.symm adj^.right_adj_left_adj),
     rw ω,
     apply adj^.right_adj_left_adj
   end

/-! #brief right_adj is injective.
-/
theorem Adj.right_adj.inj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C} (adj : Adj L R)
    {c : C^.obj} {d : D^.obj} {f₁ f₂ : D^.hom (L^.obj c) d}
    (ω : Adj.right_adj adj f₁ = Adj.right_adj adj f₂)
    : f₁ = f₂
:= begin
     apply eq.trans (eq.symm adj^.left_adj_right_adj),
     rw ω,
     apply adj^.left_adj_right_adj
   end

/- -----------------------------------------------------------------------
Bijections of categories give adjunctions.
----------------------------------------------------------------------- -/

/-! #brief The adjunction induced by a bijection.
-/
definition Cat.Bij.Adj {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F : Fun C D} {G : Fun D C}
    (FG_Bij : Cat.Bij F G)
    : Adj F G
:= { counit := NatTrans.cast FG_Bij^.id₂
   , unit := NatTrans.cast (eq.symm FG_Bij^.id₁)
   , id_left
      := λ c, begin
                repeat { rw NatTrans.cast.com },
                refine eq.trans (Cat.circ.congr_right Fun.cast_hom) _,
                refine eq.trans cast_hom.circ _,
                apply cast_hom.simp
              end
   , id_right
      := λ c, begin
                repeat { rw NatTrans.cast.com },
                refine eq.trans (Cat.circ.congr_left Fun.cast_hom) _,
                refine eq.trans cast_hom.circ _,
                apply cast_hom.simp
              end
   }

/-! #brief Bijections preserve final objects.
-/
definition Cat.Bij.PresFinal₂ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ : Fun C D} {F₂ : Fun D C}
    (bij : Cat.Bij F₁ F₂)
    : PresFinal F₂
:= { hom := λ D_HasFinal c, bij^.Adj^.right_adj (@final_hom D D_HasFinal (F₁^.obj c))
   , pres := λ D_HasFinal
             , { hom_uniq := λ c h
                             , begin
                                 apply bij^.Adj^.left_adj.inj,
                                 rw bij^.Adj^.left_adj_right_adj,
                                 apply final_hom.uniq
                               end
               }
   }

/-! #brief Bijections preserve final objects.
-/
definition Cat.Bij.PresFinal₁ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ : Fun C D} {F₂ : Fun D C}
    (bij : Cat.Bij F₁ F₂)
    : PresFinal F₁
:= bij^.flip^.PresFinal₂

/-! #brief Bijections preserve initial objects.
-/
definition Cat.Bij.PresInit₁ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ : Fun C D} {F₂ : Fun D C}
    (bij : Cat.Bij F₁ F₂)
    : PresInit F₁
:= { hom := λ C_HasInit c, bij^.Adj^.left_adj (@init_hom _ C_HasInit (F₂^.obj c))
   , pres := λ C_HasInit
             , { hom_uniq := λ c h
                             , begin
                                 apply bij^.Adj^.right_adj.inj,
                                 rw bij^.Adj^.right_adj_left_adj,
                                 apply init_hom.uniq
                               end
               }
   }

/-! #brief Bijections preserve initial objects.
-/
definition Cat.Bij.PresInit₂ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {F₁ : Fun C D} {F₂ : Fun D C}
    (bij : Cat.Bij F₁ F₂)
    : PresInit F₂
:= bij^.flip^.PresInit₁

end qp