/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.big_operators.fin
import data.finset.nat_antidiagonal
import data.fin.vec_notation
import logic.equiv.fin

/-!
# Collections of tuples of naturals with the same sum

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

This file generalizes `list.nat.antidiagonal n`, `multiset.nat.antidiagonal n`, and
`finset.nat.antidiagonal n` from the pair of elements `x : ℕ × ℕ` such that `n = x.1 + x.2`, to
the sequence of elements `x : fin k → ℕ` such that `n = ∑ i, x i`.

## Main definitions

* `list.nat.antidiagonal_tuple`
* `multiset.nat.antidiagonal_tuple`
* `finset.nat.antidiagonal_tuple`

## Main results

* `antidiagonal_tuple 2 n` is analogous to `antidiagonal n`:

  * `list.nat.antidiagonal_tuple_two`
  * `multiset.nat.antidiagonal_tuple_two`
  * `finset.nat.antidiagonal_tuple_two`

## Implementation notes

While we could implement this by filtering `(fintype.pi_finset $ λ _, range (n + 1))` or similar,
this implementation would be much slower.

In the future, we could consider generalizing `finset.nat.antidiagonal_tuple` further to
support finitely-supported functions, as is done with `cut` in
`archive/100-theorems-list/45_partition.lean`.
-/

open_locale big_operators

/-! ### Lists -/

namespace list.nat

/-- `list.antidiagonal_tuple k n` is a list of all `k`-tuples which sum to `n`.

This list contains no duplicates (`list.nat.nodup_antidiagonal_tuple`), and is sorted
lexicographically (`list.nat.antidiagonal_tuple_pairwise_pi_lex`), starting with `![0, ..., n]`
and ending with `![n, ..., 0]`.

```
#eval antidiagonal_tuple 3 2
-- [![0, 0, 2], ![0, 1, 1], ![0, 2, 0], ![1, 0, 1], ![1, 1, 0], ![2, 0, 0]]
```
-/
def antidiagonal_tuple : Π k, ℕ → list (fin k → ℕ)
| 0 0 := [![]]
| 0 (n + 1) := []
| (k + 1) n := (list.nat.antidiagonal n).bind $ λ ni,
  (antidiagonal_tuple k ni.2).map $ λ x, fin.cons (ni.1) x

@[simp] lemma antidiagonal_tuple_zero_zero : antidiagonal_tuple 0 0 = [![]] := rfl
@[simp]

lemma mem_antidiagonal_tuple {n : ℕ} {k : ℕ} {x : fin k → ℕ} :
  x ∈ antidiagonal_tuple k n ↔ ∑ i, x i = n :=
begin
  revert n,
  refine fin.cons_induction _ _ x,
  { intro n,
    cases n,
    { simp },
    { simp [eq_comm] } },
  { intros k x₀ x ih n,
    simp_rw [fin.sum_cons, antidiagonal_tuple, list.mem_bind, list.mem_map,
      list.nat.mem_antidiagonal, fin.cons_eq_cons, exists_eq_right_right, ih,
      @eq_comm _ _ (prod.snd _), and_comm (prod.snd _ = _), ←prod.mk.inj_iff, prod.mk.eta,
      exists_prop, exists_eq_right] },
end

/-- The antidiagonal of `n` does not contain duplicate entries. -/
lemma nodup_antidiagonal_tuple (k n : ℕ) : list.nodup (antidiagonal_tuple k n) :=
begin
  induction k with k ih generalizing n,
  { cases n,
    { simp },
    { simp [eq_comm] }, },
  simp_rw [antidiagonal_tuple, list.nodup_bind],
  split,
  { intros i hi,
    exact (ih i.snd).map (fin.cons_right_injective (i.fst : (λ _, ℕ) 0)), },
  induction n,
  { exact list.pairwise_singleton _ _ },
  { rw list.nat.antidiagonal_succ,
    refine list.pairwise.cons (λ a ha x hx₁ hx₂, _) (n_ih.map _ (λ a b h x hx₁ hx₂, _)),
    { rw list.mem_map at hx₁ hx₂ ha,
      obtain ⟨⟨a, -, rfl⟩, ⟨x₁, -, rfl⟩, ⟨x₂, -, h⟩⟩ := ⟨ha, hx₁, hx₂⟩,
      rw fin.cons_eq_cons at h,
      injection h.1, },
    { rw list.mem_map at hx₁ hx₂,
      obtain ⟨⟨x₁, hx₁, rfl⟩, ⟨x₂, hx₂, h₁₂⟩⟩ := ⟨hx₁, hx₂⟩,
      dsimp at h₁₂,
      rw [fin.cons_eq_cons, nat.succ_inj'] at h₁₂,
      obtain ⟨h₁₂, rfl⟩ := h₁₂,
      rw h₁₂ at h,
      exact h (list.mem_map_of_mem _ hx₁) (list.mem_map_of_mem _ hx₂) }, },
end

lemma antidiagonal_tuple_zero_right : ∀ k, antidiagonal_tuple k 0 = [0]
| 0 := congr_arg (λ x, [x]) $ subsingleton.elim _ _
| (k + 1) := begin
  rw [antidiagonal_tuple, antidiagonal_zero, list.bind_singleton, antidiagonal_tuple_zero_right k,
    list.map_singleton],
  exact congr_arg (λ x, [x]) matrix.cons_zero_zero
end

@[simp] lemma antidiagonal_tuple_one (n : ℕ) : antidiagonal_tuple 1 n = [![n]] :=
begin
  simp_rw [antidiagonal_tuple, antidiagonal, list.range_succ, list.map_append, list.map_singleton,
    tsub_self, list.bind_append, list.bind_singleton, antidiagonal_tuple_zero_zero,
    list.map_singleton, list.map_bind],
  conv_rhs { rw ← list.nil_append [![n]]},
  congr' 1,
  simp_rw [list.bind_eq_nil, list.mem_range, list.map_eq_nil],
  intros x hx,
  obtain ⟨m, rfl⟩ := nat.exists_eq_add_of_lt hx,
  rw [add_assoc, add_tsub_cancel_left, antidiagonal_tuple_zero_succ],
end

lemma antidiagonal_tuple_two (n : ℕ) :
  antidiagonal_tuple 2 n = (antidiagonal n).map (λ i, ![i.1, i.2]) :=
begin
  rw antidiagonal_tuple,
  simp_rw [antidiagonal_tuple_one, list.map_singleton],
  rw [list.map_eq_bind],
  refl,
end

lemma antidiagonal_tuple_pairwise_pi_lex : ∀ k n,
  (antidiagonal_tuple k n).pairwise (pi.lex (<) (λ _, (<)))
| 0 0 := list.pairwise_singleton _ _
| 0 (n + 1) := list.pairwise.nil
| (k + 1) n := begin
  simp_rw [antidiagonal_tuple, list.pairwise_bind, list.pairwise_map, list.mem_map,
    forall_exists_index, and_imp, forall_apply_eq_imp_iff₂],
  simp only [mem_antidiagonal, prod.forall, and_imp, forall_apply_eq_imp_iff₂],
  simp only [fin.pi_lex_lt_cons_cons, eq_self_iff_true, true_and, lt_self_iff_false, false_or],
  refine ⟨λ _ _ _, antidiagonal_tuple_pairwise_pi_lex k _, _⟩,
  induction n,
  { rw [antidiagonal_zero],
    exact list.pairwise_singleton _ _ },
  { rw [antidiagonal_succ, list.pairwise_cons, list.pairwise_map],
    refine ⟨λ p hp x hx y hy, _, _⟩,
    { rw [list.mem_map, prod.exists] at hp,
      obtain ⟨a, b, hab, (rfl : (nat.succ a, b) = p)⟩ := hp,
      exact or.inl (nat.zero_lt_succ _), },
    dsimp,
    simp_rw [nat.succ_inj', nat.succ_lt_succ_iff],
    exact n_ih },
end

end list.nat

/-! ### Multisets -/
namespace multiset.nat

/-- `multiset.antidiagonal_tuple k n` is a multiset of `k`-tuples summing to `n` -/
def antidiagonal_tuple (k n : ℕ) : multiset (fin k → ℕ) :=
list.nat.antidiagonal_tuple k n

@[simp] lemma antidiagonal_tuple_zero_zero : antidiagonal_tuple 0 0 = { ![]} := rfl
@[simp] lemma antidiagonal_tuple_zero_succ (n : ℕ) : antidiagonal_tuple 0 n.succ = 0 := rfl

lemma mem_antidiagonal_tuple {n : ℕ} {k : ℕ} {x : fin k → ℕ} :
  x ∈ antidiagonal_tuple k n ↔ ∑ i, x i = n :=
list.nat.mem_antidiagonal_tuple

lemma nodup_antidiagonal_tuple (k n : ℕ) : (antidiagonal_tuple k n).nodup :=
list.nat.nodup_antidiagonal_tuple _ _

lemma antidiagonal_tuple_zero_right (k : ℕ) : antidiagonal_tuple k 0 = {0} :=
congr_arg _ (list.nat.antidiagonal_tuple_zero_right k)

@[simp] lemma antidiagonal_tuple_one (n : ℕ) : antidiagonal_tuple 1 n = { ![n]} :=
congr_arg _ (list.nat.antidiagonal_tuple_one n)

lemma antidiagonal_tuple_two (n : ℕ) :
  antidiagonal_tuple 2 n = (antidiagonal n).map (λ i, ![i.1, i.2]) :=
congr_arg _ (list.nat.antidiagonal_tuple_two n)

end multiset.nat

/-! ### Finsets -/
namespace finset.nat

/-- `finset.antidiagonal_tuple k n` is a finset of `k`-tuples summing to `n` -/
def antidiagonal_tuple (k n : ℕ) : finset (fin k → ℕ) :=
⟨multiset.nat.antidiagonal_tuple k n, multiset.nat.nodup_antidiagonal_tuple k n⟩

@[simp] lemma antidiagonal_tuple_zero_zero : antidiagonal_tuple 0 0 = { ![]} := rfl
@[simp] lemma antidiagonal_tuple_zero_succ (n : ℕ) : antidiagonal_tuple 0 n.succ = ∅ := rfl

lemma mem_antidiagonal_tuple {n : ℕ} {k : ℕ} {x : fin k → ℕ} :
  x ∈ antidiagonal_tuple k n ↔ ∑ i, x i = n :=
list.nat.mem_antidiagonal_tuple

lemma antidiagonal_tuple_zero_right (k : ℕ) : antidiagonal_tuple k 0 = {0} :=
finset.eq_of_veq (multiset.nat.antidiagonal_tuple_zero_right k)

@[simp] lemma antidiagonal_tuple_one (n : ℕ) : antidiagonal_tuple 1 n = { ![n]} :=
finset.eq_of_veq (multiset.nat.antidiagonal_tuple_one n)

lemma antidiagonal_tuple_two (n : ℕ) :
  antidiagonal_tuple 2 n = (antidiagonal n).map (pi_fin_two_equiv (λ _, ℕ)).symm.to_embedding :=
finset.eq_of_veq (multiset.nat.antidiagonal_tuple_two n)

section equiv_prod

/-- The disjoint union of antidiagonal tuples `Σ n, antidiagonal_tuple k n` is equivalent to the
`k`-tuple `fin k → ℕ`. This is such an equivalence, obtained by mapping `(n, x)` to `x`.

This is the tuple version of `finset.nat.sigma_antidiagonal_equiv_prod`. -/
@[simps] def sigma_antidiagonal_tuple_equiv_tuple (k : ℕ) :
  (Σ n, antidiagonal_tuple k n) ≃ (fin k → ℕ) :=
{ to_fun := λ x, x.2,
  inv_fun := λ x, ⟨∑ i, x i, x, mem_antidiagonal_tuple.mpr rfl⟩,
  left_inv := λ ⟨n, t, h⟩, sigma.subtype_ext (mem_antidiagonal_tuple.mp h) rfl,
  right_inv := λ x, rfl }

end equiv_prod

end finset.nat


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

! This file was ported from Lean 3 source module category_theory.preadditive.schur
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.Ext
import Mathbin.CategoryTheory.Simple
import Mathbin.CategoryTheory.Linear.Basic
import Mathbin.CategoryTheory.Endomorphism
import Mathbin.Algebra.Algebra.Spectrum

/-!
# Schur's lemma
We first prove the part of Schur's Lemma that holds in any preadditive category with kernels,
that any nonzero morphism between simple objects
is an isomorphism.

Second, we prove Schur's lemma for `𝕜`-linear categories with finite dimensional hom spaces,
over an algebraically closed field `𝕜`:
the hom space `X ⟶ Y` between simple objects `X` and `Y` is at most one dimensional,
and is 1-dimensional iff `X` and `Y` are isomorphic.
-/

namespace CategoryTheory

open CategoryTheory.Limits

variable {C : Type _} [Category C]

variable [Preadditive C]

-- See also `epi_of_nonzero_to_simple`, which does not require `preadditive C`.
theorem mono_of_nonzero_from_simple [HasKernels C] {X Y : C} [Simple X] {f : X ⟶ Y} (w : f ≠ 0) :
    Mono f :=
  Preadditive.mono_of_kernel_zero (kernel_zero_of_nonzero_from_simple w)
#align category_theory.mono_of_nonzero_from_simple CategoryTheory.mono_of_nonzero_from_simple

/-- The part of **Schur's lemma** that holds in any preadditive category with kernels:
that a nonzero morphism between simple objects is an isomorphism.
-/
theorem isIso_of_hom_simple [HasKernels C] {X Y : C} [Simple X] [Simple Y] {f : X ⟶ Y} (w : f ≠ 0) :
    IsIso f :=
  haveI := mono_of_nonzero_from_simple w
  is_iso_of_mono_of_nonzero w
#align category_theory.is_iso_of_hom_simple CategoryTheory.isIso_of_hom_simple

/-- As a corollary of Schur's lemma for preadditive categories,
any morphism between simple objects is (exclusively) either an isomorphism or zero.
-/
theorem isIso_iff_nonzero [HasKernels C] {X Y : C} [Simple X] [Simple Y] (f : X ⟶ Y) :
    IsIso f ↔ f ≠ 0 :=
  ⟨fun I => by
    intro h
    apply id_nonzero X
    simp only [← is_iso.hom_inv_id f, h, zero_comp], fun w => isIso_of_hom_simple w⟩
#align category_theory.is_iso_iff_nonzero CategoryTheory.isIso_iff_nonzero

/-- In any preadditive category with kernels,
the endomorphisms of a simple object form a division ring.
-/
noncomputable instance [HasKernels C] {X : C} [Simple X] : DivisionRing (End X) := by
  classical exact
      {
        (inferInstance :
          Ring
            (End
              X)) with
        inv := fun f =>
          if h : f = 0 then 0
          else
            haveI := is_iso_of_hom_simple h
            inv f
        exists_pair_ne := ⟨𝟙 X, 0, id_nonzero _⟩
        inv_zero := dif_pos rfl
        mul_inv_cancel := fun f h => by
          haveI := is_iso_of_hom_simple h
          convert is_iso.inv_hom_id f
          exact dif_neg h }

open FiniteDimensional

section

variable (𝕜 : Type _) [DivisionRing 𝕜]

/-- Part of **Schur's lemma** for `𝕜`-linear categories:
the hom space between two non-isomorphic simple objects is 0-dimensional.
-/
theorem finrank_hom_simple_simple_eq_zero_of_not_iso [HasKernels C] [Linear 𝕜 C] {X Y : C}
    [Simple X] [Simple Y] (h : (X ≅ Y) → False) : finrank 𝕜 (X ⟶ Y) = 0 :=
  haveI :=
    subsingleton_of_forall_eq (0 : X ⟶ Y) fun f =>
      by
      have p := not_congr (is_iso_iff_nonzero f)
      simp only [Classical.not_not, Ne.def] at p
      refine' p.mp fun _ => h (as_iso f)
  finrank_zero_of_subsingleton
#align category_theory.finrank_hom_simple_simple_eq_zero_of_not_iso CategoryTheory.finrank_hom_simple_simple_eq_zero_of_not_iso

end

variable (𝕜 : Type _) [Field 𝕜]

variable [IsAlgClosed 𝕜] [Linear 𝕜 C]

-- In the proof below we have some difficulty using `I : finite_dimensional 𝕜 (X ⟶ X)`
-- where we need a `finite_dimensional 𝕜 (End X)`.
-- These are definitionally equal, but without eta reduction Lean can't see this.
-- To get around this, we use `convert I`,
-- then check the various instances agree field-by-field,
-- We prove this with the explicit `is_iso_iff_nonzero` assumption,
-- rather than just `[simple X]`, as this form is useful for
-- Müger's formulation of semisimplicity.
/-- An auxiliary lemma for Schur's lemma.

If `X ⟶ X` is finite dimensional, and every nonzero endomorphism is invertible,
then `X ⟶ X` is 1-dimensional.
-/
theorem finrank_endomorphism_eq_one {X : C} (is_iso_iff_nonzero : ∀ f : X ⟶ X, IsIso f ↔ f ≠ 0)
    [I : FiniteDimensional 𝕜 (X ⟶ X)] : finrank 𝕜 (X ⟶ X) = 1 :=
  by
  have id_nonzero := (is_iso_iff_nonzero (𝟙 X)).mp (by infer_instance)
  apply finrank_eq_one (𝟙 X)
  · exact id_nonzero
  · intro f
    haveI : Nontrivial (End X) := nontrivial_of_ne _ _ id_nonzero
    obtain ⟨c, nu⟩ :=
      @spectrum.nonempty_of_isAlgClosed_of_finiteDimensional 𝕜 (End X) _ _ _ _ _
        (by
          convert I
          ext
          rfl
          ext
          rfl)
        (End.of f)
    use c
    rw [spectrum.mem_iff, IsUnit.sub_iff, is_unit_iff_is_iso, is_iso_iff_nonzero, Ne.def,
      Classical.not_not, sub_eq_zero, Algebra.algebraMap_eq_smul_one] at nu
    exact nu.symm
#align category_theory.finrank_endomorphism_eq_one CategoryTheory.finrank_endomorphism_eq_one

variable [HasKernels C]

/-- **Schur's lemma** for endomorphisms in `𝕜`-linear categories.
-/
theorem finrank_endomorphism_simple_eq_one (X : C) [Simple X] [I : FiniteDimensional 𝕜 (X ⟶ X)] :
    finrank 𝕜 (X ⟶ X) = 1 :=
  finrank_endomorphism_eq_one 𝕜 isIso_iff_nonzero
#align category_theory.finrank_endomorphism_simple_eq_one CategoryTheory.finrank_endomorphism_simple_eq_one

theorem endomorphism_simple_eq_smul_id {X : C} [Simple X] [I : FiniteDimensional 𝕜 (X ⟶ X)]
    (f : X ⟶ X) : ∃ c : 𝕜, c • 𝟙 X = f :=
  (finrank_eq_one_iff_of_nonzero' (𝟙 X) (id_nonzero X)).mp (finrank_endomorphism_simple_eq_one 𝕜 X)
    f
#align category_theory.endomorphism_simple_eq_smul_id CategoryTheory.endomorphism_simple_eq_smul_id

/-- Endomorphisms of a simple object form a field if they are finite dimensional.
This can't be an instance as `𝕜` would be undetermined.
-/
noncomputable def fieldEndOfFiniteDimensional (X : C) [Simple X] [I : FiniteDimensional 𝕜 (X ⟶ X)] :
    Field (End X) := by
  classical exact
      { (inferInstance : DivisionRing (End X)) with
        mul_comm := fun f g =>
          by
          obtain ⟨c, rfl⟩ := endomorphism_simple_eq_smul_id 𝕜 f
          obtain ⟨d, rfl⟩ := endomorphism_simple_eq_smul_id 𝕜 g
          simp [← mul_smul, mul_comm c d] }
#align category_theory.field_End_of_finite_dimensional CategoryTheory.fieldEndOfFiniteDimensional

-- There is a symmetric argument that uses `[finite_dimensional 𝕜 (Y ⟶ Y)]` instead,
-- but we don't bother proving that here.
/-- **Schur's lemma** for `𝕜`-linear categories:
if hom spaces are finite dimensional, then the hom space between simples is at most 1-dimensional.

See `finrank_hom_simple_simple_eq_one_iff` and `finrank_hom_simple_simple_eq_zero_iff` below
for the refinements when we know whether or not the simples are isomorphic.
-/
theorem finrank_hom_simple_simple_le_one (X Y : C) [FiniteDimensional 𝕜 (X ⟶ X)] [Simple X]
    [Simple Y] : finrank 𝕜 (X ⟶ Y) ≤ 1 :=
  by
  cases' subsingleton_or_nontrivial (X ⟶ Y) with h
  · skip
    rw [finrank_zero_of_subsingleton]
    exact zero_le_one
  · obtain ⟨f, nz⟩ := (nontrivial_iff_exists_ne 0).mp h
    haveI fi := (is_iso_iff_nonzero f).mpr nz
    apply finrank_le_one f
    intro g
    obtain ⟨c, w⟩ := endomorphism_simple_eq_smul_id 𝕜 (g ≫ inv f)
    exact ⟨c, by simpa using w =≫ f⟩
#align category_theory.finrank_hom_simple_simple_le_one CategoryTheory.finrank_hom_simple_simple_le_one

theorem finrank_hom_simple_simple_eq_one_iff (X Y : C) [FiniteDimensional 𝕜 (X ⟶ X)]
    [FiniteDimensional 𝕜 (X ⟶ Y)] [Simple X] [Simple Y] :
    finrank 𝕜 (X ⟶ Y) = 1 ↔ Nonempty (X ≅ Y) :=
  by
  fconstructor
  · intro h
    rw [finrank_eq_one_iff'] at h
    obtain ⟨f, nz, -⟩ := h
    rw [← is_iso_iff_nonzero] at nz
    exact ⟨as_iso f⟩
  · rintro ⟨f⟩
    have le_one := finrank_hom_simple_simple_le_one 𝕜 X Y
    have zero_lt : 0 < finrank 𝕜 (X ⟶ Y) :=
      finrank_pos_iff_exists_ne_zero.mpr ⟨f.hom, (is_iso_iff_nonzero f.hom).mp inferInstance⟩
    linarith
#align category_theory.finrank_hom_simple_simple_eq_one_iff CategoryTheory.finrank_hom_simple_simple_eq_one_iff

theorem finrank_hom_simple_simple_eq_zero_iff (X Y : C) [FiniteDimensional 𝕜 (X ⟶ X)]
    [FiniteDimensional 𝕜 (X ⟶ Y)] [Simple X] [Simple Y] : finrank 𝕜 (X ⟶ Y) = 0 ↔ IsEmpty (X ≅ Y) :=
  by
  rw [← not_nonempty_iff, ← not_congr (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y)]
  refine'
    ⟨fun h => by
      rw [h]
      simp, fun h => _⟩
  have := finrank_hom_simple_simple_le_one 𝕜 X Y
  interval_cases h' : finrank 𝕜 (X ⟶ Y)
  · exact h'
  · exact False.elim (h h')
#align category_theory.finrank_hom_simple_simple_eq_zero_iff CategoryTheory.finrank_hom_simple_simple_eq_zero_iff

open Classical

theorem finrank_hom_simple_simple (X Y : C) [∀ X Y : C, FiniteDimensional 𝕜 (X ⟶ Y)] [Simple X]
    [Simple Y] : finrank 𝕜 (X ⟶ Y) = if Nonempty (X ≅ Y) then 1 else 0 :=
  by
  split_ifs
  exact (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y).2 h
  exact (finrank_hom_simple_simple_eq_zero_iff 𝕜 X Y).2 (not_nonempty_iff.mp h)
#align category_theory.finrank_hom_simple_simple CategoryTheory.finrank_hom_simple_simple

end CategoryTheory


/-
Tag 01HS

Lemma 25.5.1. Let R be a ring. Let f∈R.

    If g∈R and D(g)⊂D(f), then
        f is invertible in Rg,
        ge=af for some e≥1 and a∈R,
        there is a canonical ring map Rf→Rg, and
        there is a canonical Rf-module map Mf→Mg for any R-module M.
    Any open covering of D(f) can be refined to a finite open covering of the form D(f)=⋃ni=1D(gi).
    If g1,…,gn∈R, then D(f)⊂⋃D(gi) if and only if g1,…,gn generate the unit ideal in Rf.

Proof. Recall that D(g)=Spec(Rg) (see tag 00E4). Thus (a) holds because f maps to an element of Rg which
 is not contained in any prime ideal, and hence invertible, see tag 00E0. Write the inverse of f in Rg as a/gd.
 This means gd−af is annihilated by a power of g, whence (b). For (c), the map Rf→Rg exists by (a) from the
 universal property of localization, or we can define it by mapping b/fn to anb/gne. The equality Mf=M⊗RRf can be used to obtain the map on modules, or we can define Mf→Mg by mapping x/fn to anx/gne.

Recall that D(f) is quasi-compact, see tag 00F6. Hence the second statement follows directly from the fact that the standard opens form a basis for the topology.

The third statement follows directly from tag 00E0.
-/

import Kenny_comm_alg.Zariski localization_UMP
import tensor_product
import tag00E2
import tag00E4
import tag00E8 -- Spec(R) is compact
import Kenny_comm_alg.avoid_powers algebra.module
import mathlib_someday.topology

universes u v

local attribute [instance] classical.prop_decidable

-- the next line should not be here. It's in broken Atiyah.lean.
-- KB added it to localization_UMP in localization namespace

--def is_unit {α : Type u} [comm_ring α] (x : α) := ∃ y, x * y = 1

--localization.of_comm_ring :
--  Π (α : Type u_1) [_inst_1 : comm_ring α] (S : set α) [_inst_2 : is_submonoid α S], α → localization.loc α S

example (R : Type u) [comm_ring R] (f : R) : topological_space (X R) := by apply_instance

/-- Stacks project tag 01HS -/
lemma lemma_standard_open_1b (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f)) :
  ∃ e : ℕ, ∃ a, g^e = a*f :=
have h1 : ¬∀ n, g^n ∉ span {f},
from λ h,
  let P := @@is_ideal.avoid_powers _ g (span {f}) is_ideal_span h in
  have h1 : ∀ n : ℕ, g ^ n ∉ P,
    from @@is_ideal.avoid_powers.avoid_powers _ g (span {f}) is_ideal_span h,
  have h2 : span {f} ⊆ P,
    from @is_ideal.avoid_powers.contains _ _ g (span {f}) is_ideal_span h,
  have h3 : is_prime_ideal P,
    from @@is_ideal.avoid_powers.is_prime_ideal _ g (span {f}) is_ideal_span h,
  have h4 : (⟨P, h3⟩ : X R) ∈ Spec.D' g,
    from λ h5, h1 1 $ by simpa [monoid.pow] using h5,
  H h4 $ h2 $ subset_span $ set.mem_singleton f,
begin
  simp [not_forall, span, span_singleton] at h1,
  rcases h1 with ⟨e, a, h⟩,
  exact ⟨e, a, h.symm⟩
end

lemma lemma_standard_open_1a (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f)) :
  localization.is_unit (localization.of_comm_ring R (powers g) f) :=
let ⟨e, a, h⟩ := lemma_standard_open_1b R f g H in
⟨⟦(a,(⟨g^e,⟨e,rfl⟩⟩:powers g))⟧,
 quotient.sound $ ⟨(1:R), ⟨0, rfl⟩, by simp [h, mul_comm]⟩⟩

noncomputable def lemma_standard_open_1c (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f)) :
  localization.away f → localization.away g :=
localization.away.extend_map_of_im_unit
  (localization.of_comm_ring R (powers g))
  (lemma_standard_open_1a R f g H) -- regardless of my incompetence above, I now need that
  -- if p:R->S is a ring hom and image of f is a unit then there's a unique q:R[1/f]->S
  -- such that p is q ∘ localization.of_comm_ring . Do we have this?

  -- Note that this lemma should have a uniqueness statement too, saying that there is precisely
  -- one R-algebra morphism between these rings. The uniqueness is essential because we want
  -- define O_X(U) to be R[1/f] if U=D(f), however this is not well-defined, so I propose
  -- defining it as the subring of the product (over all f such that )

instance lemma_standard_open_1c.is_ring_hom (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f)) :
  is_ring_hom (lemma_standard_open_1c R f g H) :=
localization.away.extend_map_of_im_unit.is_ring_hom _ _

local attribute [instance] is_ring_hom.to_module

set_option eqn_compiler.zeta true
def lemma_standard_open_1c.is_linear_map (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f)) :
  is_linear_map (lemma_standard_open_1c R f g H) :=
{ add := λ x y, is_ring_hom.map_add _,
  smul := λ c x, calc
          lemma_standard_open_1c R f g H (localization.of_comm_ring R _ c * x)
        = lemma_standard_open_1c R f g H (localization.of_comm_ring R _ c) * lemma_standard_open_1c R f g H x : is_ring_hom.map_mul _
    ... = localization.of_comm_ring R _ c * lemma_standard_open_1c R f g H x : congr_arg (λ z, z * lemma_standard_open_1c R f g H x) (localization.away.extend_map_extends _ _ _) }

noncomputable def lemma_standard_open_1d (R : Type u) [comm_ring R] (f : R) (g : R) (H : Spec.D'(g) ⊆ Spec.D'(f))
  (M : Type) [module R M] :
  tensor_product M (localization.loc R (powers f)) → tensor_product M (localization.loc R (powers g)) :=
tensor_product.tprod_map
  is_linear_map.id
  (lemma_standard_open_1c.is_linear_map R f g H)

set_option pp.proofs true

def lemma_standard_open_2 (R : Type u) [comm_ring R] (f : R) (α : Type u)
  (cover : α → set (X R)) (Hcover : ∀ i : α, topological_space.is_open (Zariski R) (cover i)) :
  set.Union cover = Spec.D'(f) → ∃ γ : Type u, ∃ refine : γ → α, ∃ g : γ → R,
  ∃ H : fintype γ, (∀ m : γ, Spec.D'(g m) ⊆ cover (refine m)) ∧ set.Union (λ m, Spec.D'(g m)) = Spec.D'(f)
   :=

begin
  intro cover_covers,
  let Rf := localization.away f, -- R[1/f]
  have H1 : compact (@set.univ (X Rf)) := lemma_quasi_compact,
  let g := localization.of_comm_ring R (powers f),
  let φ := Zariski.induced g,
--   in
--  topological_space.open_immersion φ ∧ φ '' set.univ = Spec.D'(f) :=
  have H2 : compact (Spec.D' f),
    rw (lemma_standard_open R f).2.symm,
    exact compact_image H1 (Zariski.induced.continuous g),
  -- now refine cover to be a cover by basis elements
  -- first a bunch of axiom of choice nonsense
  let basis_cover := λ (i : α), classical.some (topological_space.Union_basis_elements_of_open (D_f_form_basis R) (Hcover i)),
  have basis_cover_proof : ∀ (i : α),
    (∃ (f : (basis_cover i) → set (X R)), cover i = set.Union f ∧ ∀ (t : (basis_cover i)), f t ∈ standard_basis R)
  := λ (i : α), classical.some_spec (topological_space.Union_basis_elements_of_open (D_f_form_basis R) (Hcover i)),
  -- and we now need a lemma that says that any open is a union of basis elements
  -- then we build beta as a sigma type
  -- and beta has a map to alpha
  let β := Σ (i : α), basis_cover i,
  let basis_cover_proof_function := λ i, classical.some (basis_cover_proof i),
  have basis_cover_proof_proof : ∀ (i : α),
  (cover i = set.Union (basis_cover_proof_function i)) ∧ (∀ (j : basis_cover i), (basis_cover_proof_function i) j ∈ standard_basis R)
  := λ i, classical.some_spec (basis_cover_proof i),

  let cover' : β → set (X R) := λ j,basis_cover_proof_function j.1 j.2,
  -- claim that cover' is a cover
  have Hcover' : set.Union cover' = Spec.D' f,
    rw set.subset.antisymm_iff,
    split,
    { intros b Hb,
      cases Hb with V HV,cases HV with HV Hb,cases HV with j Hj,
      have Htemp := (basis_cover_proof_proof j.1).1,
      -- ready for proof now
      rw ←cover_covers,
      apply set.subset_Union cover j.1,
      rw Htemp,
      apply set.subset_Union (basis_cover_proof_function j.1) j.2,
      suffices : basis_cover_proof_function (j.1) (j.2) = cover' j,
        rwa [this,←Hj],
      refl,
    },
    { intro y,
      rw ←cover_covers,
      intro Hy,
      cases Hy with V HV,
      cases HV with HV Hy,
      cases HV with i Hi,
      rw Hi at Hy,
      rw (basis_cover_proof_proof i).1 at Hy,
      cases Hy with W HW,
      cases HW with H HW,
      cases H with i2 Hi2,
      existsi W,
      existsi _,assumption,
      existsi (⟨i,i2⟩ : β),
      exact Hi2,
    },
  have H := compact_elim_finite_subcover H2,
    show set (set (X R)),
    exact (set.range cover'),
  have H' : (∀ (t : set (X R)), t ∈ set.range cover' → is_open t),
    intros U HU,
    cases HU with j Hj,
    rw ←Hj,
    apply topological_space.is_open_of_is_topological_basis (D_f_form_basis R),
    exact (basis_cover_proof_proof j.1).2 j.2,
  have H'' : Spec.D' f ⊆ ⋃₀ set.range cover',
    rw ←Hcover',
    rw ←set.Union_eq_sUnion_range,
  have H3 := H H' H'',clear H H' H'',
  -- I've morally deone it now.
  -- I just need to interface my way to the results.
  cases H3 with fcover H,
  cases H with Hf Hc,
  existsi {k // k ∈ fcover},
  existsi _,tactic.swap,
    intro kk,
    have H : kk.1 ∈ set.range cover',
      exact Hf kk.2,
    let j := classical.some H,
    have jproof : cover' j = kk.val := classical.some_spec H,
    exact j.1,
  existsi _,tactic.swap,
    intro kk,
    have H : kk.1 ∈ set.range cover',
      exact Hf kk.2,
    let j := classical.some H,
    have j'proof : cover' j = kk.val := classical.some_spec H,
    have H2 := (basis_cover_proof_proof j.1).2 j.2,
    exact classical.some H2,
  existsi _,tactic.swap,
    exact set.finite.fintype Hc.1,
  split,
  { intros U x Hx,
    let j := classical.some (Hf (U.property)),
    show x ∈ cover (j.1),
    let g := classical.some ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    have gproof : basis_cover_proof_function (j.fst) (j.snd) = Spec.D' (g) := classical.some_spec ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    change x ∈ Spec.D' g at Hx,
    rw (basis_cover_proof_proof (j.fst)).1,
    existsi cover' j,
    existsi _,tactic.swap,
      existsi j.2,
      refl,
    show x ∈ basis_cover_proof_function (j.fst) (j.snd),
    rwa gproof,
  },
  show (⋃ (U : {k // k ∈ fcover}),
       Spec.D'
         (classical.some
            ((basis_cover_proof_proof ((classical.some (Hf (U.property))).fst)).right
               ((classical.some (Hf (U.property))).snd)))) =
    Spec.D' f,
  rw set.subset.antisymm_iff,
  split,
  { refine set.Union_subset _,
    intro U,
    let j := classical.some (Hf (U.property)),
    let g := classical.some ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    have gproof : basis_cover_proof_function (j.fst) (j.snd) = Spec.D' (g) := classical.some_spec ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    show Spec.D' g ⊆ Spec.D' f,
    rw ←gproof,
    refine @set.subset.trans _ _ (cover j.fst) _ _ _,
    { rw (basis_cover_proof_proof j.fst).1,
      exact set.subset_Union _ _,
    },
  rw ←cover_covers,
  apply set.subset_Union,
  },
  -- gamble
  suffices : ⋃₀ fcover = ⋃ (U : {k // k ∈ fcover}),
      Spec.D'
        (classical.some
           ((basis_cover_proof_proof ((classical.some (Hf (U.property))).fst)).right
              ((classical.some (Hf (U.property))).snd))),
    rw ←this,
    exact Hc.2,
  -- is this true?
  have H : ∀ U : {k // k ∈ fcover}, U.1 = Spec.D'
        (classical.some
           ((basis_cover_proof_proof ((classical.some (Hf (U.property))).fst)).right
              ((classical.some (Hf (U.property))).snd))),
    intro U,
    let j := classical.some (Hf (U.property)),
    let g := classical.some ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    have gproof : basis_cover_proof_function (j.fst) (j.snd) = Spec.D' (g) := classical.some_spec ((basis_cover_proof_proof (j.fst)).right (j.snd)),
    show U.val = Spec.D' g,
    rw ←gproof,
    have jproof : cover' j = U.val := classical.some_spec (Hf (U.property)),
    rw ←jproof,
  rw set.sUnion_eq_Union,
  show (⋃ (U : {k // k ∈ fcover}), U.val) = _,
  rw funext H, -- many thanks Chris Hughes for that classy finish :-)
end

lemma zariski.basis_is_compact (R : Type u) [comm_ring R] : basis_is_compact (D_f_form_basis R) :=
begin
  intros U HU,
  cases HU with f Hf,
  intros α Ui HUi cover,
  have H := lemma_standard_open_2 R f α Ui begin
    intro i,
    exact topological_space.is_open_of_is_topological_basis (D_f_form_basis R) (HUi i),
  end
  begin
    rw ←Hf,
    rw cover,
  end,
  cases H with γ Hγ,
  existsi γ,
  cases Hγ with f Hγ,
  cases Hγ with g Hγ,
  cases Hγ with Hfin Hγ,
  existsi Hfin,
  existsi f,
  refine set.subset.antisymm _ _,
    refine set.Union_subset _,
    rw ←cover,
    intro j,
    apply set.subset_Union,
  rw Hf,
  rw ←Hγ.2,
  intros x Hx,
  cases Hx with V HV,
  cases HV with HV Hx,
  cases HV with j Hj,
  change V = Spec.D' (g j) at Hj,
  suffices :  ∃ (i : γ), x ∈ Ui (f i),
    simpa using this,
  existsi j,
  apply Hγ.1 j,
  rwa ←Hj,
end