import algebra.group_power
import ring_theory.ideal_operations
import ring_theory.subring

import for_mathlib.rings
import for_mathlib.equiv

import valuation.linear_ordered_comm_group_with_zero

/-!

# The basics of valuation theory.

The basic theory of valuations (non-archimedean norms) on a commutative ring,
following T. Wedhorn's unpublished notes “Adic Spaces” ([Wedhorn])

The definition of a valuation we use here is Definition 1.22 of [Wedhorn]. `valuation R Γ₀`
is the type of valuations R → Γ₀, with a coercion to the underlying
function. If v is a valuation from R to Γ₀ then the induced group
homomorphism units(R) → Γ₀ is called `unit_map v`.

The equivalence "relation" `is_equiv v₁ v₂ : Prop` defined in [Wedhorn; 1.27] is not strictly
speaking a relation, because v₁ : valuation R Γ₁ and v₂ : valuation R Γ₂ might
not have the same type. This corresponds in ZFC to the set-theoretic difficulty
that the class of all valuations (as Γ₀ varies) on a ring R is not a set.
The "relation" is however reflexive, symmetric and transitive in the obvious
sense. Note that we use 1.27(iii) as the definition of equivalence.

The trivial valuation associated to a prime ideal P of R is `trivial P : valuation R Γ₀`.

The support of a valuation v : valuation R Γ₀ is `supp v`. If J is an ideal of R
with `h : J ⊆ supp v` then the induced valuation
on R / J = `ideal.quotient J` is `on_quot v h`.

-/

local attribute [instance] classical.prop_decidable
noncomputable theory

local attribute [instance, priority 0] classical.DLO

open function ideal linear_ordered_structure

universes u u₀ u₁ u₂ -- v is used for valuations

variables {R : Type u₀} -- This will be a ring, assumed commutative in some sections

variables {Γ₀   : Type u}  [linear_ordered_comm_group_with_zero Γ₀]
variables {Γ'₀  : Type u₁} [linear_ordered_comm_group_with_zero Γ'₀]
variables {Γ''₀ : Type u₂} [linear_ordered_comm_group_with_zero Γ''₀]

set_option old_structure_cmd true

section
variables (R) (Γ₀) [ring R]

/-- The type of Γ₀-valued valuations on R. -/
structure valuation extends R →* Γ₀ :=
(map_zero' : to_fun 0 = 0)
(map_add' : ∀ x y, to_fun (x + y) ≤ max (to_fun x) (to_fun y))

end

namespace valuation

section basic
variables (R) (Γ₀) [ring R]

/-- A valuation is coerced to the underlying function R → Γ₀. -/
instance : has_coe_to_fun (valuation R Γ₀) := { F := λ _, R → Γ₀, coe := valuation.to_fun }

/-- A valuation is coerced to a monoid morphism R → Γ₀. -/
instance : has_coe (valuation R Γ₀) (R →* Γ₀) := ⟨valuation.to_monoid_hom⟩

variables {R} {Γ₀} (v : valuation R Γ₀) {x y z : R}

@[squash_cast, simp] lemma coe_coe : ((v : R →* Γ₀) : R → Γ₀) = v := rfl

@[simp] lemma map_zero : v 0 = 0 := v.map_zero'
@[simp] lemma map_one  : v 1 = 1 := v.map_one'
@[simp] lemma map_mul  : ∀ x y, v (x * y) = v x * v y := v.map_mul'
@[simp] lemma map_add  : ∀ x y, v (x + y) ≤ max (v x) (v y) := v.map_add'

@[simp] lemma map_pow  : ∀ x (n:ℕ), v (x^n) = (v x)^n :=
@is_monoid_hom.map_pow _ _ _ _ v (monoid_hom.is_monoid_hom v.to_monoid_hom)

@[ext] lemma ext {v₁ v₂ : valuation R Γ₀} (h : ∀ r, v₁ r = v₂ r) : v₁ = v₂ :=
by { cases v₁, cases v₂, congr, funext r, exact h r }

lemma ext_iff {v₁ v₂ : valuation R Γ₀} : v₁ = v₂ ↔ ∀ r, v₁ r = v₂ r :=
⟨λ h r, congr_arg _ h, ext⟩

-- The following definition is not an instance, because we have more than one v on a given R.
/-- A valuation gives a preorder on the underlying ring. -/
def to_preorder : preorder R := preorder.lift v (by apply_instance)

/-- If v is a valuation on a division ring then v(x) = 0 iff x = 0. -/
lemma zero_iff {K : Type u₀} [division_ring K]
  (v : valuation K Γ₀) {x : K} : v x = 0 ↔ x = 0 :=
begin
  split ; intro h,
  { contrapose! h,
    exact group_with_zero.unit_ne_zero (units.map (v : K →* Γ₀) $ units.mk0 _ h) },
  { exact h.symm ▸ v.map_zero },
end

lemma ne_zero_iff {K : Type u₀} [division_ring K]
  (v : valuation K Γ₀) {x : K} : v x ≠ 0 ↔ x ≠ 0 :=
not_iff_not_of_iff v.zero_iff

@[simp] lemma map_inv' {K : Type u₀} [division_ring K]
  (v : valuation K Γ₀) {x : K} (h : x ≠ 0) : v x⁻¹ = (v x)⁻¹ :=
begin
  apply eq_inv_of_mul_right_eq_one',
  rw [← v.map_mul, mul_inv_cancel h, v.map_one]
end

@[simp] lemma map_inv {K : Type u₀} [discrete_field K]
  (v : valuation K Γ₀) {x : K} : v x⁻¹ = (v x)⁻¹ :=
begin
  by_cases h : x = 0,
  { rw [h, inv_zero, map_zero, inv_zero'] },
  { exact v.map_inv' h }
end

lemma map_units_inv (x : units R) : v (x⁻¹ : units R) = (v x)⁻¹ :=
eq_inv_of_mul_right_eq_one' _ _ $ by rw [← v.map_mul, units.mul_inv, v.map_one]

@[simp] theorem unit_map_eq (u : units R) :
  (units.map (v : R →* Γ₀) u : Γ₀) = v u := rfl

@[simp] theorem map_neg_one : v (-1) = 1 :=
begin
  show (units.map (v : R →* Γ₀) (-1 : units R) : Γ₀) = (1 : units Γ₀),
  rw ← units.ext_iff,
  apply linear_ordered_structure.eq_one_of_pow_eq_one (nat.succ_ne_zero _) (_ : _ ^ 2 = _),
  rw [pow_two, ← monoid_hom.map_mul, units.ext_iff],
  show v ((-1) * (-1)) = 1,
  rw [neg_one_mul, neg_neg, v.map_one]
end

@[simp] lemma map_neg (x : R) : v (-x) = v x :=
calc v (-x) = v (-1 * x)   : by simp
        ... = v (-1) * v x : map_mul _ _ _
        ... = v x          : by simp

lemma map_sub_swap (x y : R) : v (x - y) = v (y - x) :=
calc v (x - y) = v (-(y - x)) : by rw show x - y = -(y-x), by abel
           ... = _ : map_neg _ _

lemma map_sub_le_max (x y : R) : v (x - y) ≤ max (v x) (v y) :=
calc v (x-y) = v (x + -y)   : by simp
        ... ≤ max (v x) (v $ -y) : v.map_add _ _
        ... = max (v x) (v y)    : by rw map_neg

lemma map_add_of_distinct_val (h : v x ≠ v y) : v (x + y) = max (v x) (v y) :=
begin
  suffices : ¬v (x + y) < max (v x) (v y),
    from or_iff_not_imp_right.1 (le_iff_eq_or_lt.1 (v.map_add x y)) this,
  intro h',
  wlog vyx : v y < v x using x y,
  { apply lt_or_gt_of_ne h.symm },
  { rw max_eq_left_of_lt vyx at h',
    apply lt_irrefl (v x),
    calc v x = v ((x+y) - y)         : by simp
         ... ≤ max (v $ x + y) (v y) : map_sub_le_max _ _ _
         ... < v x                   : max_lt h' vyx },
  { apply this h.symm,
    rwa [add_comm, max_comm] at h' }
end

lemma map_eq_of_sub_lt (h : v (y - x) < v x) : v y = v x :=
begin
  have := valuation.map_add_of_distinct_val v (ne_of_gt h).symm,
  rw max_eq_right (le_of_lt h) at this,
  simpa using this
end

/-- A ring homomorphism S → R induces a map valuation R Γ₀ → valuation S Γ₀ -/
def comap {S : Type u₁} [ring S] (f : S → R) [is_ring_hom f] (v : valuation R Γ₀) :
  valuation S Γ₀ :=
by refine_struct { to_fun := v ∘ f, .. }; intros;
  simp [is_ring_hom.map_zero f, is_ring_hom.map_one f, is_ring_hom.map_mul f, is_ring_hom.map_add f]

@[simp] lemma comap_id : v.comap (id : R → R) = v := ext $ λ r, rfl

lemma comap_comp {S₁ : Type u₁} [ring S₁] {S₂ : Type u₂} [ring S₂]
(f : S₁ → S₂) [is_ring_hom f] (g : S₂ → R) [is_ring_hom g] :
  v.comap (g ∘ f) = (v.comap g).comap f :=
ext $ λ r, rfl

/-- A ≤-preserving group homomorphism Γ₀ → Γ'₀ induces a map valuation R Γ₀ → valuation R Γ'₀. -/
def map (f : Γ₀ →* Γ'₀) (h₀ : f 0 = 0) (hf : monotone f) (v : valuation R Γ₀) : valuation R Γ'₀ :=
{ to_fun := f ∘ v,
  map_zero' := show f (v 0) = 0, by rw [v.map_zero, h₀],
  map_add' := λ r s,
    calc f (v (r + s)) ≤ f (max (v r) (v s))     : hf (v.map_add r s)
                   ... = max (f (v r)) (f (v s)) : hf.map_max,
  .. monoid_hom.comp f (v : R →* Γ₀) }

/-- Two valuations on R are defined to be equivalent if they induce the same preorder on R. -/
def is_equiv (v₁ : valuation R Γ₀) (v₂ : valuation R Γ'₀) : Prop :=
∀ r s, v₁ r ≤ v₁ s ↔ v₂ r ≤ v₂ s

end basic -- end of section

namespace is_equiv
variables [ring R]
variables {v : valuation R Γ₀}
variables {v₁ : valuation R Γ₀} {v₂ : valuation R Γ'₀} {v₃ : valuation R Γ''₀}

@[refl] lemma refl : v.is_equiv v :=
λ _ _, iff.refl _

@[symm] lemma symm (h : v₁.is_equiv v₂) : v₂.is_equiv v₁ :=
λ _ _, iff.symm (h _ _)

@[trans] lemma trans (h₁₂ : v₁.is_equiv v₂) (h₂₃ : v₂.is_equiv v₃) : v₁.is_equiv v₃ :=
λ _ _, iff.trans (h₁₂ _ _) (h₂₃ _ _)

lemma of_eq {v' : valuation R Γ₀} (h : v = v') : v.is_equiv v' :=
by subst h; refl

lemma map {v' : valuation R Γ₀} (f : Γ₀ →* Γ'₀) (h₀ : f 0 = 0) (hf : monotone f) (inf : injective f)
  (h : v.is_equiv v') :
  (v.map f h₀ hf).is_equiv (v'.map f h₀ hf) :=
λ r s,
calc f (v r) ≤ f (v s) ↔ v r ≤ v s : by rw linear_order_le_iff_of_monotone_injective inf hf
                   ... ↔ v' r ≤ v' s : h r s
                   ... ↔ f (v' r) ≤ f (v' s) : by rw linear_order_le_iff_of_monotone_injective inf hf

/-- `comap` preserves equivalence. -/
lemma comap {S : Type u₂} [ring S] (f : S → R) [is_ring_hom f] (h : v₁.is_equiv v₂) :
  (v₁.comap f).is_equiv (v₂.comap f) :=
λ r s, h (f r) (f s)

lemma val_eq (h : v₁.is_equiv v₂) {r s : R} :
  v₁ r = v₁ s ↔ v₂ r = v₂ s :=
⟨λ H, le_antisymm ((h _ _).1 (le_of_eq H)) ((h _ _).1 (le_of_eq H.symm)),
 λ H, le_antisymm ((h.symm _ _).1 (le_of_eq H)) ((h.symm _ _).1 (le_of_eq H.symm)) ⟩

lemma ne_zero (h : v₁.is_equiv v₂) {r : R} :
  v₁ r ≠ 0 ↔ v₂ r ≠ 0 :=
begin
  have : v₁ r ≠ v₁ 0 ↔ v₂ r ≠ v₂ 0 := not_iff_not_of_iff h.val_eq,
  rwa [v₁.map_zero, v₂.map_zero] at this,
end

end is_equiv -- end of namespace

lemma is_equiv_of_map_strict_mono [ring R] {v : valuation R Γ₀}
  (f : Γ₀ →* Γ'₀) (h₀ : f 0 = 0) (H : strict_mono f) :
  is_equiv (v.map f h₀ (H.monotone)) v :=
λ x y, ⟨H.le_iff_le.mp, λ h, H.monotone h⟩

lemma is_equiv_of_val_le_one {K : Type*} [division_ring K]
  (v : valuation K Γ₀) (v' : valuation K Γ'₀) (h : ∀ {x:K}, v x ≤ 1 ↔ v' x ≤ 1) :
  v.is_equiv v' :=
begin
  intros x y,
  by_cases hy : y = 0, { simp [hy, zero_iff], },
  rw show y = 1 * y, by rw one_mul,
  rw show x = (x * y⁻¹) * y, { rw [mul_assoc, inv_mul_cancel hy, mul_one], },
  iterate 2 {rw [v.map_mul _ y, v'.map_mul _ y]},
  rw [v.map_one, v'.map_one],
  split; intro H,
  { apply actual_ordered_comm_monoid.mul_le_mul_right',
    replace hy := v.ne_zero_iff.mpr hy,
    replace H := linear_ordered_structure.le_of_le_mul_right hy H,
    rwa h at H, },
  { apply actual_ordered_comm_monoid.mul_le_mul_right',
    replace hy := v'.ne_zero_iff.mpr hy,
    replace H := linear_ordered_structure.le_of_le_mul_right hy H,
    rwa h, },
end

/-- A valuation is trivial if it maps everything to 0 or 1.-/
def is_trivial [ring R] (v : valuation R Γ₀) : Prop :=
∀ r:R, v r = 0 ∨ v r = 1

section trivial -- the trivial valuation
variable [comm_ring R]
variables (I : ideal R) [prime : I.is_prime]

/-- The trivial Γ₀-valued valuation associated to a prime ideal S of R. -/
def trivial : valuation R (with_zero punit) :=
{ to_fun := λ x, if x ∈ I then 0 else 1,
  map_zero' := if_pos I.zero_mem,
  map_one'  := if_neg (assume h, prime.1 (I.eq_top_iff_one.2 h)),
  map_mul'  := λ x y,
    if hx : x ∈ I then by rw [if_pos hx, zero_mul, if_pos (I.mul_mem_right hx)]
    else if hy : y ∈ I then by rw [if_pos hy, mul_zero, if_pos (I.mul_mem_left hy)]
    else have hxy : x * y ∉ I,
    by { assume hxy, replace hxy := prime.mem_or_mem hxy, tauto },
    by rw [if_neg hx, if_neg hy, if_neg hxy, mul_one],
  map_add'  := λ x y, begin
      split_ifs with hxy hx hy _ hx hy;
      try {simp}; try {exact le_refl _},
      { exact hxy (I.add_mem hx hy) }
    end }

lemma trivial_is_trivial (I : ideal R) [hI : I.is_prime] :
  (trivial I).is_trivial :=
begin
  intro r, generalize : (trivial I) r = x,
  cases x; [left, {right, cases x}]; refl
end

lemma is_trivial_iff_val_le_one {K : Type*} [division_ring K] {v : valuation K Γ₀} :
  v.is_trivial ↔ ∀ x:K, v x ≤ 1 :=
begin
  split; intros h x,
  { cases h x; simp *, },
  { contrapose! h, cases h with h₁ h₂,
    by_cases hx : v x ≤ 1,
    { refine ⟨x⁻¹, _⟩,
      rw [v.map_inv', ← linear_ordered_structure.inv_lt_inv _ _,
        inv_inv'', inv_one'],
      { exact lt_of_le_of_ne hx h₂ },
      { exact inv_ne_zero' _ h₁ },
      { exact one_ne_zero },
      { rwa v.ne_zero_iff at h₁, } },
    { push_neg at hx, exact ⟨_, hx⟩ } }
end

end trivial -- end of section

section supp
variables  [comm_ring R]
variables (v : valuation R Γ₀)

/-- The support of a valuation v : R → Γ₀ is the ideal of R where v vanishes. -/
def supp : ideal R :=
{ carrier := {x | v x = 0},
  zero := map_zero v,
  add  := λ x y hx hy, le_zero_iff.mp $
    calc v (x + y) ≤ max (v x) (v y) : v.map_add x y
               ... ≤ 0               : max_le (le_zero_iff.mpr hx) (le_zero_iff.mpr hy),
  smul  := λ c x hx, calc v (c * x)
                        = v c * v x : map_mul v c x
                    ... = v c * 0 : congr_arg _ hx
                    ... = 0 : mul_zero _ }

@[simp] lemma mem_supp_iff (x : R) : x ∈ supp v ↔ v x = 0 := iff.rfl
-- @[simp] lemma mem_supp_iff' (x : R) : x ∈ (supp v : set R) ↔ v x = 0 := iff.rfl

/-- The support of a valuation is a prime ideal. -/
instance : ideal.is_prime (supp v) :=
⟨λ (h : v.supp = ⊤), one_ne_zero $ show (1 : Γ₀) = 0,
from calc 1 = v 1 : v.map_one.symm
        ... = 0   : show (1:R) ∈ supp v, by rw h; trivial,
 λ x y hxy, begin
    show v x = 0 ∨ v y = 0,
    change v (x * y) = 0 at hxy,
    rw [v.map_mul x y] at hxy,
    exact group_with_zero.mul_eq_zero _ _ hxy
  end⟩

/-- v(a)=v(a+s) if s ∈ supp(v). -/
lemma val_add_supp (a s : R) (h : s ∈ supp v) : v (a + s) = v a :=
begin
  have aux : ∀ a s, v s = 0 → v (a + s) ≤ v a,
  { intros a' s' h', refine le_trans (v.map_add a' s') (max_le (le_refl _) _), simp [h'], },
  apply le_antisymm (aux a s h),
  calc v a = v (a + s + -s) : by simp
       ... ≤ v (a + s)      : aux (a + s) (-s) (by rwa ←ideal.neg_mem_iff at h)
end

/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
Note: it's just the function; the valuation is `on_quot hJ`. -/
definition on_quot_val {J : ideal R} (hJ : J ≤ supp v) :
  J.quotient → Γ₀ :=
λ q, quotient.lift_on' q v $ λ a b h,
calc v a = v (b + (a - b)) : by simp
     ... = v b             : v.val_add_supp b (a - b) (hJ h)

/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
definition on_quot {J : ideal R} (hJ : J ≤ supp v) :
  valuation J.quotient Γ₀ :=
{ to_fun := v.on_quot_val hJ,
  map_zero' := v.map_zero,
  map_one'  := v.map_one,
  map_mul'  := λ xbar ybar, quotient.ind₂' v.map_mul xbar ybar,
  map_add'  := λ xbar ybar, quotient.ind₂' v.map_add xbar ybar }

@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
ext $ λ r,
begin
  refine @quotient.lift_on_beta _ _ (J.quotient_rel) v (λ a b h, _) _,
  calc v a = v (b + (a - b)) : by simp
       ... = v b             : v.val_add_supp b (a - b) (hJ h)
end

end supp -- end of section

section supp_comm
variable [comm_ring R]
variables (v : valuation R Γ₀)

lemma comap_supp {S : Type u₁} [comm_ring S] (f : S → R) [is_ring_hom f] :
  supp (v.comap f) = ideal.comap f v.supp :=
ideal.ext $ λ x,
begin
  rw [mem_supp_iff, ideal.mem_comap, mem_supp_iff],
  refl,
end

lemma self_le_supp_comap (J : ideal R) (v : valuation (quotient J) Γ₀) :
  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
by rw [comap_supp, ← ideal.map_le_iff_le_comap]; simp

@[simp] lemma comap_on_quot_eq (J : ideal R) (v : valuation J.quotient Γ₀) :
  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
ext $ by { rintro ⟨x⟩, refl }

/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
begin
  apply le_antisymm,
  { rintro ⟨x⟩ hx,
    apply ideal.subset_span,
    exact ⟨x, hx, rfl⟩ },
  { rw ideal.map_le_iff_le_comap,
    intros x hx, exact hx }
end

lemma supp_quot_supp : supp (v.on_quot (le_refl _)) = 0 :=
by rw supp_quot; exact ideal.map_quotient_self _

lemma quot_preorder_comap {J : ideal R} (hJ : J ≤ supp v) :
preorder.lift (ideal.quotient.mk J) (v.on_quot hJ).to_preorder = v.to_preorder :=
preorder.ext $ λ x y, iff.rfl

end supp_comm -- end of section

end valuation


import data.fintype.basic
import data.finset
import tactic
import finset_extra

noncomputable theory
open_locale classical
open finset

def size{β : Type*} (X: finset β) := ((card X) : ℤ )

#check subtype.val

@[simp] lemma size_subtype{β : Type*} {Y: set β} {X : finset Y} : size (X.image subtype.val)  = size X :=
begin
    unfold size,
    simp only [int.coe_nat_inj'],
    apply card_image_of_injective,
    exact subtype.val_injective
end

universes u v

structure matroid_on (E : Type u) :=
(r : finset E → ℤ)
(R1 : ∀ (X : finset E), 0 ≤ r X ∧ r X ≤ size X)
(R2 : ∀ {X Y : finset E}, X ⊆ Y → r X ≤ r Y)
(R3 : ∀ (X Y : finset E), r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y)

class matroids (α : Type v) :=
(E : α → Type u)
(to_matroid : Π (M : α), matroid_on (E M))
-- M is the name of the matroid, (E M) is the ground set of the matroid; the function to_matroid maps the name M to the structure of
-- matroid M (i.e. a rank function and proofs of axioms).

-- TOY EXAMPLES ***************************

-- Defines two matroids: a 'true matroid' and a 'false matroid' on the same ground sets (in general, ground sets need not be the same).
--The true matroid is free, false matroid has rank zero ,

namespace hidden
def α : Type := bool
example : α := tt
example : α := ff

inductive my_true_E : Type | A | B | C
def my_false_E : Type := my_true_E

def my_E : α -> Type
| tt := my_true_E
| ff := my_false_E

def my_to_matroid : Π (M : α), matroid_on (my_E M)
| tt := {
  r := (λ X, card X : (finset my_true_E -> ℤ)),
  R1 := sorry,
  R2 := sorry,
  R3 := sorry,
}
| ff := {
  r := (λ X, 0 : (finset my_true_E -> ℤ)),
  R1 := sorry,
  R2 := sorry,
  R3 := sorry,
}

example : matroids bool := {
  E := my_E,
  to_matroid := my_to_matroid,
}

-- the collection of all matroids on a fixed ground set
constant β : Type
instance : matroids (matroid_on β) := {
  E := (λ _, β),
  to_matroid := (λ M, M),
}
end hidden

-- END TOY EXAMPLES ***************************

instance matroid_on.matroids (E : Type u) : matroids (matroid_on E) :=
{ E := λ _, E,
  to_matroid := id }

namespace matroid

variables {α : Type v} [matroids α]
-- Accessor functions for terms that have a matroid representation

def E (M : α) := matroids.E M
--def groundset {M: α} : (set (E M))
def r {M : α} (X : finset (E M)) : ℤ := (matroids.to_matroid M).r X
def R1 (M : α) (X : finset (E M)) : 0 ≤ r X ∧ r X ≤ X.card := (matroids.to_matroid M).R1 X
def R2 (M : α) {X Y : finset (E M)} (h : X ⊆ Y) : r X ≤ r Y := (matroids.to_matroid M).R2 h
def R3 (M : α) (X Y : finset (E M)) : r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y := (matroids.to_matroid M).R3 X Y

@[simp] lemma r_empty_eq_zero (M : α) : r (∅ : finset (E M)) = 0 := sorry
--by { have h := R1 M ∅, rwa [card_empty, le_zero_iff_eq] at h }

lemma rank_subadditive {M : α} (X Y : finset (E M)) : r (X ∪ Y) ≤ r X + r Y := sorry
--le_trans (nat.le.intro rfl) (R3 M X Y)

lemma r_le_union {M : α} (X Y : finset (E M)) : r X ≤ r (X ∪ Y) :=
by { apply R2 M, apply subset_union_left }

lemma r_le_union_right {M : α} (X Y : finset (E M)) : r Y ≤ r (X ∪ Y) :=
by { rw union_comm, apply r_le_union }

structure submatroid (M : α) :=
(F : set (E M))

-- TOY ********************************

def my_α : Type := unit
def the_unit : unit := ()

inductive my_finite_set : Type | A | B | C
constant my_matroid : matroid_on my_finite_set
def my_instance : matroids my_α := {
  E := (λ x, my_finite_set),
  to_matroid := (λ x, my_matroid)
}

def my_finite_subset : (set my_finite_set)
| my_finite_set.A := true
| my_finite_set.B := true
| my_finite_set.C := false

example : (@submatroid my_α my_instance the_unit) := { F := my_finite_subset }
--submatroid : Π {α : Type u_2} [_inst_1 : matroids α], α → Type u_3
--Type ?m1 -> Type ?m1 + 1
-- END TOY ***************************

@[simp] def raise{β : Type*} {Y: set β} (X : finset Y) := X.image subtype.val

instance submatroid.matroid (M : α) : matroids (submatroid M) :=
{ E := λ (M' : submatroid M), M'.F,
  to_matroid := λ (M' : submatroid M),
  { r := λ (X : finset M'.F), @r _ _ M (X.image subtype.val),
    R1 := λ (X : finset M'.F),
    begin
        split,
        apply (R1 M (X.image subtype.val)).1,

        apply le_trans ((R1 M _).2),
        apply int.coe_nat_le_coe_nat_of_le,
        apply card_image_le,
        --apply ,

    end,
    R2 := λ s₁ s₂ hs, R2 M (image_subset_image hs),
    R3 := λ s₁ s₂, by { rw [image_union, image_inter], apply R3 M, apply subtype.ext, } } }

def delete (M : α) (F : set (E M)) : submatroid M :=
submatroid.mk F

structure matroid_contraction (M : α) :=
(C : finset (E M))

def contract (M : α) (C : finset (E M)) : matroid_contraction M :=
matroid_contraction.mk C

instance matroid_contraction.matroid (M : α) : matroids (matroid_contraction M) :=
{ E := λ M', ↥((↑M'.C : set (E M))ᶜ),
  to_matroid := λ M',
  { r := λ X, r (X.image subtype.val ∪ M'.C) - r M'.C,
    R1 := λ X,
    begin
      let X' := X.image subtype.val,
      split,
      linarith [R2 M (subset_union_right X' M'.C : M'.C ⊆ X' ∪ M'.C)],

      have := rank_subadditive X' M'.C,

      calc r (X' ∪ M'.C) - r M'.C ≤ r X'        : by linarith
                             ...  ≤ size X'     : (R1 M X').2
                             ...  = size X      : by simp,
    end,
    R2 := λ X,
    begin
        intros Y hXY,
        let X' := X.image subtype.val,
        let Y' := Y.image subtype.val,
        have : X' ⊆ Y', exact image_subset_image hXY,
        have := R2 M ((union_subset_union_left this) : (X' ∪ M'.C ⊆ Y' ∪ M'.C)),
        linarith,
    end,
    R3 :=
    begin
        intros X Y,
        let X' := X.image subtype.val,
        let Y' := Y.image subtype.val,
        rw [image_union, image_inter],
        have := R3 M (X' ∪ M'.C) (Y' ∪ M'.C),
        simp only [@union_unions _ _ X' Y' _, inter_unions]  at this,

        linarith,
        intros x y,
        exact subtype.eq,
    end,
    }
 }

def dual (M : α) [fintype (E M)] : matroid_on (E M) :=
{ r := λ X, r (univ.filter (λ x, x ∉ X)) + X.card - r (univ : finset (E M)),
  R1 := sorry,
  R2 := sorry,
  R3 := sorry }

end matroid


import game.sets.L01defs
import game.sup_inf.GLBprop_if_LUBprop
import data.real.basic
import tactic.linarith
import game.limits.defs

namespace xena -- hide

local notation `|`x`|` := abs x
/-
# Chapter 7 : Limits

## Level 1

-/

/-

Using The following definitions you should be able to prove that the limit of a function
a n 'a(n)' plus the limit of another function b n 'b(n)' is just the limit of
a n + b n. Following the math proof should make this proof very attainable.

definition is_limit (a : ℕ → ℝ) (α : ℝ) :=
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - α| < ε

def seq (n : ℕ) (a : ℕ → ℝ) := a n

def limit (n : ℕ) (a : ℕ → ℝ) (L : ℝ) := ∀ ε > 0, ∃ N : ℕ, n ≥ N → |a n - L | < ε

definition is_limit' (a : ℕ → ℝ) (α : ℝ) :=
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - α| ≤ ε
-/

lemma lim_add (a : ℕ → ℝ) (b : ℕ → ℝ) (α β : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, (a n) + (b n) ) (α + β) :=
begin
  intro ε,
  intro j,
  set e := ε / 2 with hedef,
  have he : 0 < e,
  linarith,
  have Ha := ha e he,
  have Hb := hb e he,
  cases Ha with d hd,
  cases Hb with t ht,
  set m := max d t with hm,
  have q : m ≥ d, norm_num,
  have  r : m ≥ t, norm_num,
  use m,
  intros v hv,
  have I : v ≥ d, linarith,
  have O : v ≥ t, linarith,
  have W := hd v I,
  have X := ht v O,
  have H := abs_add (a v - α) (b v - β),
  simp,
  have G : a v - α + (b v - β) = a v + b v - (α + β), linarith,
  rw G at H,
  have F : |a v - α| + |b v - β| < 2 * e, linarith,
  have E : |a v + b v - (α + β)| < 2 * e, linarith,
  have D : 2 * e = ε, linarith,
  rw D at E,
  exact E,
end
end xena -- hide


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import algebra.direct_sum.finsupp
import linear_algebra.finsupp
import linear_algebra.direct_sum.tensor_product

/-!
# Results on finitely supported functions.

The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N).
-/

universes u v w

noncomputable theory
open_locale direct_sum

open set linear_map submodule
variables {R : Type u} {M : Type v} {N : Type w} [ring R] [add_comm_group M] [module R M]
  [add_comm_group N] [module R N]

section tensor_product

open tensor_product
open_locale tensor_product classical

/-- The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N). -/
def finsupp_tensor_finsupp (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N] :
  (ι →₀ M) ⊗[R] (κ →₀ N) ≃ₗ[R] (ι × κ) →₀ (M ⊗[R] N) :=
(tensor_product.congr (finsupp_lequiv_direct_sum R M ι) (finsupp_lequiv_direct_sum R N κ))
  ≪≫ₗ ((tensor_product.direct_sum R (λ _ : ι, M) (λ _ : κ, N))
  ≪≫ₗ (finsupp_lequiv_direct_sum R (M ⊗[R] N) (ι × κ)).symm)

@[simp] theorem finsupp_tensor_finsupp_single (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (i : ι) (m : M) (k : κ) (n : N) :
  finsupp_tensor_finsupp R M N ι κ (finsupp.single i m ⊗ₜ finsupp.single k n) =
  finsupp.single (i, k) (m ⊗ₜ n) :=
by simp [finsupp_tensor_finsupp]

@[simp] theorem finsupp_tensor_finsupp_apply (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (f : ι →₀ M) (g : κ →₀ N) (i : ι) (k : κ) :
  finsupp_tensor_finsupp R M N ι κ (f ⊗ₜ g) (i, k) = f i ⊗ₜ g k :=
begin
  apply finsupp.induction_linear f,
  { simp, },
  { intros f₁ f₂ hf₁ hf₂, simp [add_tmul, hf₁, hf₂], },
  { intros i' m,
    apply finsupp.induction_linear g,
    { simp, },
    { intros g₁ g₂ hg₁ hg₂, simp [tmul_add, hg₁, hg₂], },
    { intros k' n,
      simp only [finsupp_tensor_finsupp_single],
      simp only [finsupp.single_apply],
      -- split_ifs; finish can close the goal from here
      by_cases h1 : (i', k') = (i, k),
      { simp only [prod.mk.inj_iff] at h1, simp [h1] },
      { simp only [h1, if_false],
        simp only [prod.mk.inj_iff, not_and_distrib] at h1,
        cases h1; simp [h1] } } }
end

@[simp] theorem finsupp_tensor_finsupp_symm_single (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (i : ι × κ) (m : M) (n : N) :
  (finsupp_tensor_finsupp R M N ι κ).symm (finsupp.single i (m ⊗ₜ n)) =
  (finsupp.single i.1 m ⊗ₜ finsupp.single i.2 n) :=
prod.cases_on i $ λ i k, (linear_equiv.symm_apply_eq _).2
  (finsupp_tensor_finsupp_single _ _ _ _ _ _ _ _ _).symm

variables (S : Type*) [comm_ring S] (α β : Type*)

/--
A variant of `finsupp_tensor_finsupp` where both modules are the ground ring.
-/
def finsupp_tensor_finsupp' : ((α →₀ S) ⊗[S] (β →₀ S)) ≃ₗ[S] (α × β →₀ S) :=
(finsupp_tensor_finsupp S S S α β).trans (finsupp.lcongr (equiv.refl _) (tensor_product.lid S S))

@[simp] lemma finsupp_tensor_finsupp'_apply_apply (f : α →₀ S) (g : β →₀ S) (a : α) (b : β) :
  finsupp_tensor_finsupp' S α β (f ⊗ₜ[S] g) (a, b) = f a * g b :=
by simp [finsupp_tensor_finsupp']

@[simp] lemma finsupp_tensor_finsupp'_single_tmul_single (a : α) (b : β) (r₁ r₂ : S) :
  finsupp_tensor_finsupp' S α β (finsupp.single a r₁ ⊗ₜ[S] finsupp.single b r₂) =
    finsupp.single (a, b) (r₁ * r₂) :=
by { ext ⟨a', b'⟩, simp [finsupp.single_apply, ite_and] }

end tensor_product


import game.max.level07 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter ? : Max and abs

## Level 8

See if you can do `max_lt_iff` without introducing
any auxiliary hypotheses with `have`. Don't forget to
check the list of theorems to see the interface for `≤`
and `<`.
-/

/- Lemma
If $a$, $b$, $c$ are real numbers,
then ($a<c$ and $b<c$) iff $\max(a,b)<c.$
-/

theorem max_lt_iff {a b c : ℝ} : a < c ∧ b < c ↔ max a b < c :=
begin
  split,
  { intro h,
    cases h with hac hbc,
    exact max_lt hac hbc
  },
  { intro habc,
    split,
    { apply lt_of_le_of_lt _ habc,
      apply le_max_left},
    { apply lt_of_le_of_lt _ habc,
      apply le_max_right
    }
  },
end

end xena --hide


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import algebraic_geometry.prime_spectrum.basic
import algebra.category.CommRing.colimits
import algebra.category.CommRing.limits
import topology.sheaves.local_predicate
import ring_theory.localization
import ring_theory.subring.basic

/-!
# The structure sheaf on `prime_spectrum R`.

We define the structure sheaf on `Top.of (prime_spectrum R)`, for a commutative ring `R` and prove
basic properties about it. We define this as a subsheaf of the sheaf of dependent functions into the
localizations, cut out by the condition that the function must be locally equal to a ratio of
elements of `R`.

Because the condition "is equal to a fraction" passes to smaller open subsets,
the subset of functions satisfying this condition is automatically a subpresheaf.
Because the condition "is locally equal to a fraction" is local,
it is also a subsheaf.

(It may be helpful to refer back to `topology.sheaves.sheaf_of_functions`,
where we show that dependent functions into any type family form a sheaf,
and also `topology.sheaves.local_predicate`, where we characterise the predicates
which pick out sub-presheaves and sub-sheaves of these sheaves.)

We also set up the ring structure, obtaining
`structure_sheaf R : sheaf CommRing (Top.of (prime_spectrum R))`.

We then construct two basic isomorphisms, relating the structure sheaf to the underlying ring `R`.
First, `structure_sheaf.stalk_iso` gives an isomorphism between the stalk of the structure sheaf
at a point `p` and the localization of `R` at the prime ideal `p`. Second,
`structure_sheaf.basic_open_iso` gives an isomorphism between the structure sheaf on `basic_open f`
and the localization of `R` at the submonoid of powers of `f`.

## References

* [Robin Hartshorne, *Algebraic Geometry*][Har77]

-/

universe u

noncomputable theory

variables (R : Type u) [comm_ring R]

open Top
open topological_space
open category_theory
open opposite

namespace algebraic_geometry

/--
The prime spectrum, just as a topological space.
-/
def prime_spectrum.Top : Top := Top.of (prime_spectrum R)

namespace structure_sheaf

/--
The type family over `prime_spectrum R` consisting of the localization over each point.
-/
@[derive [comm_ring, local_ring]]
def localizations (P : prime_spectrum.Top R) : Type u := localization.at_prime P.as_ideal

instance (P : prime_spectrum.Top R) : inhabited (localizations R P) :=
⟨1⟩

instance (U : opens (prime_spectrum.Top R)) (x : U) :
  algebra R (localizations R x) :=
localization.algebra

instance (U : opens (prime_spectrum.Top R)) (x : U) :
  is_localization.at_prime (localizations R x) (x : prime_spectrum.Top R).as_ideal :=
localization.is_localization

variables {R}

/--
The predicate saying that a dependent function on an open `U` is realised as a fixed fraction
`r / s` in each of the stalks (which are localizations at various prime ideals).
-/
def is_fraction {U : opens (prime_spectrum.Top R)} (f : Π x : U, localizations R x) : Prop :=
∃ (r s : R), ∀ x : U,
  ¬ (s ∈ x.1.as_ideal) ∧ f x * algebra_map _ _ s = algebra_map _ _ r

lemma is_fraction.eq_mk' {U : opens (prime_spectrum.Top R)} {f : Π x : U, localizations R x}
  (hf : is_fraction f) :
  ∃ (r s : R) , ∀ x : U, ∃ (hs : s ∉ x.1.as_ideal), f x =
    is_localization.mk' (localization.at_prime _) r
      (⟨s, hs⟩ : (x : prime_spectrum.Top R).as_ideal.prime_compl) :=
begin
  rcases hf with ⟨r, s, h⟩,
  refine ⟨r, s, λ x, ⟨(h x).1, (is_localization.mk'_eq_iff_eq_mul.mpr _).symm⟩⟩,
  exact (h x).2.symm,
end

variables (R)

/--
The predicate `is_fraction` is "prelocal",
in the sense that if it holds on `U` it holds on any open subset `V` of `U`.
-/
def is_fraction_prelocal : prelocal_predicate (localizations R) :=
{ pred := λ U f, is_fraction f,
  res := by { rintro V U i f ⟨r, s, w⟩, exact ⟨r, s, λ x, w (i x)⟩ } }

/--
We will define the structure sheaf as
the subsheaf of all dependent functions in `Π x : U, localizations R x`
consisting of those functions which can locally be expressed as a ratio of
(the images in the localization of) elements of `R`.

Quoting Hartshorne:

For an open set $U ⊆ Spec A$, we define $𝒪(U)$ to be the set of functions
$s : U → ⨆_{𝔭 ∈ U} A_𝔭$, such that $s(𝔭) ∈ A_𝔭$ for each $𝔭$,
and such that $s$ is locally a quotient of elements of $A$:
to be precise, we require that for each $𝔭 ∈ U$, there is a neighborhood $V$ of $𝔭$,
contained in $U$, and elements $a, f ∈ A$, such that for each $𝔮 ∈ V, f ∉ 𝔮$,
and $s(𝔮) = a/f$ in $A_𝔮$.

Now Hartshorne had the disadvantage of not knowing about dependent functions,
so we replace his circumlocution about functions into a disjoint union with
`Π x : U, localizations x`.
-/
def is_locally_fraction : local_predicate (localizations R) :=
(is_fraction_prelocal R).sheafify

@[simp]
lemma is_locally_fraction_pred
  {U : opens (prime_spectrum.Top R)} (f : Π x : U, localizations R x) :
  (is_locally_fraction R).pred f =
  ∀ x : U, ∃ (V) (m : x.1 ∈ V) (i : V ⟶ U),
  ∃ (r s : R), ∀ y : V,
  ¬ (s ∈ y.1.as_ideal) ∧
    f (i y : U) * algebra_map _ _ s = algebra_map _ _ r :=
rfl

/--
The functions satisfying `is_locally_fraction` form a subring.
-/
def sections_subring (U : (opens (prime_spectrum.Top R))ᵒᵖ) :
  subring (Π x : unop U, localizations R x) :=
{ carrier := { f | (is_locally_fraction R).pred f },
  zero_mem' :=
  begin
    refine λ x, ⟨unop U, x.2, 𝟙 _, 0, 1, λ y, ⟨_, _⟩⟩,
    { rw ←ideal.ne_top_iff_one, exact y.1.is_prime.1, },
    { simp, },
  end,
  one_mem' :=
  begin
    refine λ x, ⟨unop U, x.2, 𝟙 _, 1, 1, λ y, ⟨_, _⟩⟩,
    { rw ←ideal.ne_top_iff_one, exact y.1.is_prime.1, },
    { simp, },
  end,
  add_mem' :=
  begin
    intros a b ha hb x,
    rcases ha x with ⟨Va, ma, ia, ra, sa, wa⟩,
    rcases hb x with ⟨Vb, mb, ib, rb, sb, wb⟩,
    refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ra * sb + rb * sa, sa * sb, _⟩,
    intro y,
    rcases wa (opens.inf_le_left _ _ y) with ⟨nma, wa⟩,
    rcases wb (opens.inf_le_right _ _ y) with ⟨nmb, wb⟩,
    fsplit,
    { intro H, cases y.1.is_prime.mem_or_mem H; contradiction, },
    { simp only [add_mul, ring_hom.map_add, pi.add_apply, ring_hom.map_mul],
      erw [←wa, ←wb],
      simp only [mul_assoc],
      congr' 2,
      rw [mul_comm], refl, }
  end,
  neg_mem' :=
  begin
    intros a ha x,
    rcases ha x with ⟨V, m, i, r, s, w⟩,
    refine ⟨V, m, i, -r, s, _⟩,
    intro y,
    rcases w y with ⟨nm, w⟩,
    fsplit,
    { exact nm, },
    { simp only [ring_hom.map_neg, pi.neg_apply],
      erw [←w],
      simp only [neg_mul_eq_neg_mul_symm], }
  end,
  mul_mem' :=
  begin
    intros a b ha hb x,
    rcases ha x with ⟨Va, ma, ia, ra, sa, wa⟩,
    rcases hb x with ⟨Vb, mb, ib, rb, sb, wb⟩,
    refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ra * rb, sa * sb, _⟩,
    intro y,
    rcases wa (opens.inf_le_left _ _ y) with ⟨nma, wa⟩,
    rcases wb (opens.inf_le_right _ _ y) with ⟨nmb, wb⟩,
    fsplit,
    { intro H, cases y.1.is_prime.mem_or_mem H; contradiction, },
    { simp only [pi.mul_apply, ring_hom.map_mul],
      erw [←wa, ←wb],
      simp only [mul_left_comm, mul_assoc, mul_comm],
      refl, }
  end, }

end structure_sheaf

open structure_sheaf

/--
The structure sheaf (valued in `Type`, not yet `CommRing`) is the subsheaf consisting of
functions satisfying `is_locally_fraction`.
-/
def structure_sheaf_in_Type : sheaf (Type u) (prime_spectrum.Top R):=
subsheaf_to_Types (is_locally_fraction R)

instance comm_ring_structure_sheaf_in_Type_obj (U : (opens (prime_spectrum.Top R))ᵒᵖ) :
  comm_ring ((structure_sheaf_in_Type R).1.obj U) :=
(sections_subring R U).to_comm_ring

open _root_.prime_spectrum

/--
The structure presheaf, valued in `CommRing`, constructed by dressing up the `Type` valued
structure presheaf.
-/
@[simps]
def structure_presheaf_in_CommRing : presheaf CommRing (prime_spectrum.Top R) :=
{ obj := λ U, CommRing.of ((structure_sheaf_in_Type R).1.obj U),
  map := λ U V i,
  { to_fun := ((structure_sheaf_in_Type R).1.map i),
    map_zero' := rfl,
    map_add' := λ x y, rfl,
    map_one' := rfl,
    map_mul' := λ x y, rfl, }, }

/--
Some glue, verifying that that structure presheaf valued in `CommRing` agrees
with the `Type` valued structure presheaf.
-/
def structure_presheaf_comp_forget :
  structure_presheaf_in_CommRing R ⋙ (forget CommRing) ≅ (structure_sheaf_in_Type R).1 :=
nat_iso.of_components
  (λ U, iso.refl _)
  (by tidy)

open Top.presheaf

/--
The structure sheaf on $Spec R$, valued in `CommRing`.

This is provided as a bundled `SheafedSpace` as `Spec.SheafedSpace R` later.
-/
def structure_sheaf : sheaf CommRing (prime_spectrum.Top R) :=
⟨structure_presheaf_in_CommRing R,
  -- We check the sheaf condition under `forget CommRing`.
  (is_sheaf_iff_is_sheaf_comp _ _).mpr
    (is_sheaf_of_iso (structure_presheaf_comp_forget R).symm
      (structure_sheaf_in_Type R).property)⟩

namespace structure_sheaf

@[simp] lemma res_apply (U V : opens (prime_spectrum.Top R)) (i : V ⟶ U)
  (s : (structure_sheaf R).1.obj (op U)) (x : V) :
  ((structure_sheaf R).1.map i.op s).1 x = (s.1 (i x) : _) :=
rfl

/-

Notation in this comment

X = Spec R
OX = structure sheaf

In the following we construct an isomorphism between OX_p and R_p given any point p corresponding
to a prime ideal in R.

We do this via 8 steps:

1. def const (f g : R) (V) (hv : V ≤ D_g) : OX(V) [for api]
2. def to_open (U) : R ⟶ OX(U)
3. [2] def to_stalk (p : Spec R) : R ⟶ OX_p
4. [2] def to_basic_open (f : R) : R_f ⟶ OX(D_f)
5. [3] def localization_to_stalk (p : Spec R) : R_p ⟶ OX_p
6. def open_to_localization (U) (p) (hp : p ∈ U) : OX(U) ⟶ R_p
7. [6] def stalk_to_fiber_ring_hom (p : Spec R) : OX_p ⟶ R_p
8. [5,7] def stalk_iso (p : Spec R) : OX_p ≅ R_p

In the square brackets we list the dependencies of a construction on the previous steps.

-/

/-- The section of `structure_sheaf R` on an open `U` sending each `x ∈ U` to the element
`f/g` in the localization of `R` at `x`. -/
def const (f g : R) (U : opens (prime_spectrum.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : prime_spectrum.Top R).as_ideal.prime_compl) :
  (structure_sheaf R).1.obj (op U) :=
⟨λ x, is_localization.mk' _ f ⟨g, hu x x.2⟩,
 λ x, ⟨U, x.2, 𝟙 _, f, g, λ y, ⟨hu y y.2, is_localization.mk'_spec _ _ _⟩⟩⟩

@[simp] lemma const_apply (f g : R) (U : opens (prime_spectrum.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : prime_spectrum.Top R).as_ideal.prime_compl) (x : U) :
  (const R f g U hu).1 x = is_localization.mk' _ f ⟨g, hu x x.2⟩ :=
rfl

lemma const_apply' (f g : R) (U : opens (prime_spectrum.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : prime_spectrum.Top R).as_ideal.prime_compl) (x : U)
  (hx : g ∈ (as_ideal (x : prime_spectrum.Top R)).prime_compl) :
  (const R f g U hu).1 x = is_localization.mk' _ f ⟨g, hx⟩ :=
rfl

lemma exists_const (U) (s : (structure_sheaf R).1.obj (op U)) (x : prime_spectrum.Top R)
  (hx : x ∈ U) :
  ∃ (V : opens (prime_spectrum.Top R)) (hxV : x ∈ V) (i : V ⟶ U) (f g : R) hg,
  const R f g V hg = (structure_sheaf R).1.map i.op s :=
let ⟨V, hxV, iVU, f, g, hfg⟩ := s.2 ⟨x, hx⟩ in
⟨V, hxV, iVU, f, g, λ y hyV, (hfg ⟨y, hyV⟩).1, subtype.eq $ funext $ λ y,
is_localization.mk'_eq_iff_eq_mul.2 $ eq.symm $ (hfg y).2⟩

@[simp] lemma res_const (f g : R) (U hu V hv i) :
  (structure_sheaf R).1.map i (const R f g U hu) = const R f g V hv :=
rfl

lemma res_const' (f g : R) (V hv) :
  (structure_sheaf R).1.map (hom_of_le hv).op (const R f g (basic_open g) (λ _, id)) =
    const R f g V hv :=
rfl

lemma const_zero (f : R) (U hu) : const R 0 f U hu = 0 :=
subtype.eq $ funext $ λ x, is_localization.mk'_eq_iff_eq_mul.2 $
by erw [ring_hom.map_zero, subtype.val_eq_coe, subring.coe_zero, pi.zero_apply, zero_mul]

lemma const_self (f : R) (U hu) : const R f f U hu = 1 :=
subtype.eq $ funext $ λ x, is_localization.mk'_self _ _

lemma const_one (U) : const R 1 1 U (λ p _, submonoid.one_mem _) = 1 :=
const_self R 1 U _

lemma const_add (f₁ f₂ g₁ g₂ : R) (U hu₁ hu₂) :
  const R f₁ g₁ U hu₁ + const R f₂ g₂ U hu₂ =
  const R (f₁ * g₂ + f₂ * g₁) (g₁ * g₂) U (λ x hx, submonoid.mul_mem _ (hu₁ x hx) (hu₂ x hx)) :=
subtype.eq $ funext $ λ x, eq.symm $
by convert is_localization.mk'_add f₁ f₂ ⟨g₁, hu₁ x x.2⟩ ⟨g₂, hu₂ x x.2⟩

lemma const_mul (f₁ f₂ g₁ g₂ : R) (U hu₁ hu₂) :
  const R f₁ g₁ U hu₁ * const R f₂ g₂ U hu₂ =
  const R (f₁ * f₂) (g₁ * g₂) U (λ x hx, submonoid.mul_mem _ (hu₁ x hx) (hu₂ x hx)) :=
subtype.eq $ funext $ λ x, eq.symm $
by convert is_localization.mk'_mul _ f₁ f₂ ⟨g₁, hu₁ x x.2⟩ ⟨g₂, hu₂ x x.2⟩

lemma const_ext {f₁ f₂ g₁ g₂ : R} {U hu₁ hu₂} (h : f₁ * g₂ = f₂ * g₁) :
  const R f₁ g₁ U hu₁ = const R f₂ g₂ U hu₂ :=
subtype.eq $ funext $ λ x, is_localization.mk'_eq_of_eq h.symm

lemma const_congr {f₁ f₂ g₁ g₂ : R} {U hu} (hf : f₁ = f₂) (hg : g₁ = g₂) :
  const R f₁ g₁ U hu = const R f₂ g₂ U (hg ▸ hu) :=
by substs hf hg

lemma const_mul_rev (f g : R) (U hu₁ hu₂) :
  const R f g U hu₁ * const R g f U hu₂ = 1 :=
by rw [const_mul, const_congr R rfl (mul_comm g f), const_self]

lemma const_mul_cancel (f g₁ g₂ : R) (U hu₁ hu₂) :
  const R f g₁ U hu₁ * const R g₁ g₂ U hu₂ = const R f g₂ U hu₂ :=
by { rw [const_mul, const_ext], rw mul_assoc }

lemma const_mul_cancel' (f g₁ g₂ : R) (U hu₁ hu₂) :
  const R g₁ g₂ U hu₂ * const R f g₁ U hu₁ = const R f g₂ U hu₂ :=
by rw [mul_comm, const_mul_cancel]

/-- The canonical ring homomorphism interpreting an element of `R` as
a section of the structure sheaf. -/
def to_open (U : opens (prime_spectrum.Top R)) :
  CommRing.of R ⟶ (structure_sheaf R).1.obj (op U) :=
{ to_fun := λ f, ⟨λ x, algebra_map R _ f,
    λ x, ⟨U, x.2, 𝟙 _, f, 1, λ y, ⟨(ideal.ne_top_iff_one _).1 y.1.2.1,
      by { rw [ring_hom.map_one, mul_one], refl } ⟩⟩⟩,
  map_one' := subtype.eq $ funext $ λ x, ring_hom.map_one _,
  map_mul' := λ f g, subtype.eq $ funext $ λ x, ring_hom.map_mul _ _ _,
  map_zero' := subtype.eq $ funext $ λ x, ring_hom.map_zero _,
  map_add' := λ f g, subtype.eq $ funext $ λ x, ring_hom.map_add _ _ _ }

@[simp] lemma to_open_res (U V : opens (prime_spectrum.Top R)) (i : V ⟶ U) :
  to_open R U ≫ (structure_sheaf R).1.map i.op = to_open R V :=
rfl

@[simp] lemma to_open_apply (U : opens (prime_spectrum.Top R)) (f : R) (x : U) :
  (to_open R U f).1 x = algebra_map _ _ f :=
rfl

lemma to_open_eq_const (U : opens (prime_spectrum.Top R)) (f : R) : to_open R U f =
  const R f 1 U (λ x _, (ideal.ne_top_iff_one _).1 x.2.1) :=
subtype.eq $ funext $ λ x, eq.symm $ is_localization.mk'_one _ f

/-- The canonical ring homomorphism interpreting an element of `R` as an element of
the stalk of `structure_sheaf R` at `x`. -/
def to_stalk (x : prime_spectrum.Top R) : CommRing.of R ⟶ (structure_sheaf R).1.stalk x :=
(to_open R ⊤ ≫ (structure_sheaf R).1.germ ⟨x, ⟨⟩⟩ : _)

@[simp] lemma to_open_germ (U : opens (prime_spectrum.Top R)) (x : U) :
  to_open R U ≫ (structure_sheaf R).1.germ x =
  to_stalk R x :=
by { rw [← to_open_res R ⊤ U (hom_of_le le_top : U ⟶ ⊤), category.assoc, presheaf.germ_res], refl }

@[simp] lemma germ_to_open (U : opens (prime_spectrum.Top R)) (x : U) (f : R) :
  (structure_sheaf R).1.germ x (to_open R U f) = to_stalk R x f :=
by { rw ← to_open_germ, refl }

lemma germ_to_top (x : prime_spectrum.Top R) (f : R) :
  (structure_sheaf R).1.germ (⟨x, trivial⟩ : (⊤ : opens (prime_spectrum.Top R)))
    (to_open R ⊤ f) =
    to_stalk R x f :=
rfl

lemma is_unit_to_basic_open_self (f : R) : is_unit (to_open R (basic_open f) f) :=
is_unit_of_mul_eq_one _ (const R 1 f (basic_open f) (λ _, id)) $
by rw [to_open_eq_const, const_mul_rev]

lemma is_unit_to_stalk (x : prime_spectrum.Top R) (f : x.as_ideal.prime_compl) :
  is_unit (to_stalk R x (f : R)) :=
by { erw ← germ_to_open R (basic_open (f : R)) ⟨x, f.2⟩ (f : R),
    exact ring_hom.is_unit_map _ (is_unit_to_basic_open_self R f) }

/-- The canonical ring homomorphism from the localization of `R` at `p` to the stalk
of the structure sheaf at the point `p`. -/
def localization_to_stalk (x : prime_spectrum.Top R) :
  CommRing.of (localization.at_prime x.as_ideal) ⟶ (structure_sheaf R).1.stalk x :=
show localization.at_prime x.as_ideal →+* _, from
is_localization.lift (is_unit_to_stalk R x)

@[simp] lemma localization_to_stalk_of (x : prime_spectrum.Top R) (f : R) :
  localization_to_stalk R x (algebra_map _ (localization _) f) = to_stalk R x f :=
is_localization.lift_eq _ f

@[simp] lemma localization_to_stalk_mk' (x : prime_spectrum.Top R) (f : R)
  (s : (as_ideal x).prime_compl) :
  localization_to_stalk R x (is_localization.mk' _ f s : localization _) =
  (structure_sheaf R).1.germ (⟨x, s.2⟩ : basic_open (s : R))
    (const R f s (basic_open s) (λ _, id)) :=
(is_localization.lift_mk'_spec _ _ _ _).2 $
by erw [← germ_to_open R (basic_open s) ⟨x, s.2⟩, ← germ_to_open R (basic_open s) ⟨x, s.2⟩,
    ← ring_hom.map_mul, to_open_eq_const, to_open_eq_const, const_mul_cancel']

/-- The ring homomorphism that takes a section of the structure sheaf of `R` on the open set `U`,
implemented as a subtype of dependent functions to localizations at prime ideals, and evaluates
the section on the point corresponding to a given prime ideal. -/
def open_to_localization (U : opens (prime_spectrum.Top R)) (x : prime_spectrum.Top R)
  (hx : x ∈ U) :
  (structure_sheaf R).1.obj (op U) ⟶ CommRing.of (localization.at_prime x.as_ideal) :=
{ to_fun := λ s, (s.1 ⟨x, hx⟩ : _),
  map_one' := rfl,
  map_mul' := λ _ _, rfl,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

@[simp] lemma coe_open_to_localization (U : opens (prime_spectrum.Top R)) (x : prime_spectrum.Top R)
  (hx : x ∈ U) :
  (open_to_localization R U x hx :
    (structure_sheaf R).1.obj (op U) → localization.at_prime x.as_ideal) =
  (λ s, (s.1 ⟨x, hx⟩ : _)) :=
rfl

lemma open_to_localization_apply (U : opens (prime_spectrum.Top R)) (x : prime_spectrum.Top R)
  (hx : x ∈ U)
  (s : (structure_sheaf R).1.obj (op U)) :
  open_to_localization R U x hx s = (s.1 ⟨x, hx⟩ : _) :=
rfl

/-- The ring homomorphism from the stalk of the structure sheaf of `R` at a point corresponding to
a prime ideal `p` to the localization of `R` at `p`,
formed by gluing the `open_to_localization` maps. -/
def stalk_to_fiber_ring_hom (x : prime_spectrum.Top R) :
  (structure_sheaf R).1.stalk x ⟶ CommRing.of (localization.at_prime x.as_ideal) :=
limits.colimit.desc (((open_nhds.inclusion x).op) ⋙ (structure_sheaf R).1)
  { X := _,
    ι :=
    { app := λ U, open_to_localization R ((open_nhds.inclusion _).obj (unop U)) x (unop U).2, } }

@[simp] lemma germ_comp_stalk_to_fiber_ring_hom (U : opens (prime_spectrum.Top R)) (x : U) :
  (structure_sheaf R).1.germ x ≫ stalk_to_fiber_ring_hom R x =
  open_to_localization R U x x.2 :=
limits.colimit.ι_desc _ _

@[simp] lemma stalk_to_fiber_ring_hom_germ' (U : opens (prime_spectrum.Top R))
  (x : prime_spectrum.Top R) (hx : x ∈ U) (s : (structure_sheaf R).1.obj (op U)) :
  stalk_to_fiber_ring_hom R x ((structure_sheaf R).1.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) :=
ring_hom.ext_iff.1 (germ_comp_stalk_to_fiber_ring_hom R U ⟨x, hx⟩ : _) s

@[simp] lemma stalk_to_fiber_ring_hom_germ (U : opens (prime_spectrum.Top R)) (x : U)
  (s : (structure_sheaf R).1.obj (op U)) :
  stalk_to_fiber_ring_hom R x ((structure_sheaf R).1.germ x s) = s.1 x :=
by { cases x, exact stalk_to_fiber_ring_hom_germ' R U _ _ _ }

@[simp] lemma to_stalk_comp_stalk_to_fiber_ring_hom (x : prime_spectrum.Top R) :
  to_stalk R x ≫ stalk_to_fiber_ring_hom R x = (algebra_map _ _ : R →+* localization _) :=
by { erw [to_stalk, category.assoc, germ_comp_stalk_to_fiber_ring_hom], refl }

@[simp] lemma stalk_to_fiber_ring_hom_to_stalk (x : prime_spectrum.Top R) (f : R) :
  stalk_to_fiber_ring_hom R x (to_stalk R x f) = algebra_map _ (localization _) f :=
ring_hom.ext_iff.1 (to_stalk_comp_stalk_to_fiber_ring_hom R x) _

/-- The ring isomorphism between the stalk of the structure sheaf of `R` at a point `p`
corresponding to a prime ideal in `R` and the localization of `R` at `p`. -/
@[simps] def stalk_iso (x : prime_spectrum.Top R) :
  (structure_sheaf R).1.stalk x ≅ CommRing.of (localization.at_prime x.as_ideal) :=
{ hom := stalk_to_fiber_ring_hom R x,
  inv := localization_to_stalk R x,
  hom_inv_id' := (structure_sheaf R).1.stalk_hom_ext $ λ U hxU,
  begin
    ext s, simp only [comp_apply], rw [id_apply, stalk_to_fiber_ring_hom_germ'],
    obtain ⟨V, hxV, iVU, f, g, hg, hs⟩ := exists_const _ _ s x hxU,
    erw [← res_apply R U V iVU s ⟨x, hxV⟩, ← hs, const_apply, localization_to_stalk_mk'],
    refine (structure_sheaf R).1.germ_ext V hxV (hom_of_le hg) iVU _,
    erw [← hs, res_const']
  end,
  inv_hom_id' := @is_localization.ring_hom_ext R _ x.as_ideal.prime_compl
      (localization.at_prime x.as_ideal) _ _ (localization.at_prime x.as_ideal) _ _
      (ring_hom.comp (stalk_to_fiber_ring_hom R x) (localization_to_stalk R x))
      (ring_hom.id (localization.at_prime _)) $
    by { ext f, simp only [ring_hom.comp_apply, ring_hom.id_apply, localization_to_stalk_of,
                           stalk_to_fiber_ring_hom_to_stalk] } }

/-- The canonical ring homomorphism interpreting `s ∈ R_f` as a section of the structure sheaf
on the basic open defined by `f ∈ R`. -/
def to_basic_open (f : R) : localization.away f →+*
  (structure_sheaf R).1.obj (op $ basic_open f) :=
is_localization.away.lift f (is_unit_to_basic_open_self R f)

@[simp] lemma to_basic_open_mk' (s f : R) (g : submonoid.powers s) :
  to_basic_open R s (is_localization.mk' (localization.away s) f g) =
  const R f g (basic_open s) (λ x hx, submonoid.powers_subset hx g.2) :=
(is_localization.lift_mk'_spec _ _ _ _).2 $
by rw [to_open_eq_const, to_open_eq_const, const_mul_cancel']

@[simp] lemma localization_to_basic_open (f : R) :
  ring_hom.comp (to_basic_open R f) (algebra_map R (localization.away f)) =
    to_open R (basic_open f) :=
ring_hom.ext $ λ g,
by rw [to_basic_open, is_localization.away.lift, ring_hom.comp_apply, is_localization.lift_eq]

@[simp] lemma to_basic_open_to_map (s f : R) :
  to_basic_open R s (algebra_map R (localization.away s) f) =
    const R f 1 (basic_open s) (λ _ _, submonoid.one_mem _) :=
(is_localization.lift_eq _ _).trans $ to_open_eq_const _ _ _

-- The proof here follows the argument in Hartshorne's Algebraic Geometry, Proposition II.2.2.
lemma to_basic_open_injective (f : R) : function.injective (to_basic_open R f) :=
begin
  intros s t h_eq,
  obtain ⟨a, ⟨b, hb⟩, rfl⟩ := is_localization.mk'_surjective (submonoid.powers f) s,
  obtain ⟨c, ⟨d, hd⟩, rfl⟩ := is_localization.mk'_surjective (submonoid.powers f) t,
  simp only [to_basic_open_mk'] at h_eq,
  rw is_localization.eq,
  -- We know that the fractions `a/b` and `c/d` are equal as sections of the structure sheaf on
  -- `basic_open f`. We need to show that they agree as elements in the localization of `R` at `f`.
  -- This amounts showing that `a * d * r = c * b * r`, for some power `r = f ^ n` of `f`.
  -- We define `I` as the ideal of *all* elements `r` satisfying the above equation.
  let I : ideal R :=
  { carrier := {r : R | a * d * r = c * b * r},
    zero_mem' := by simp only [set.mem_set_of_eq, mul_zero],
    add_mem' := λ r₁ r₂ hr₁ hr₂, by { dsimp at hr₁ hr₂ ⊢, simp only [mul_add, hr₁, hr₂] },
    smul_mem' := λ r₁ r₂ hr₂, by { dsimp at hr₂ ⊢, simp only [mul_comm r₁ r₂, ← mul_assoc, hr₂] }},
  -- Our claim now reduces to showing that `f` is contained in the radical of `I`
  suffices : f ∈ I.radical,
  { cases this with n hn,
    exact ⟨⟨f ^ n, n, rfl⟩, hn⟩ },
  rw [← vanishing_ideal_zero_locus_eq_radical, mem_vanishing_ideal],
  intros p hfp,
  contrapose hfp,
  rw [mem_zero_locus, set.not_subset],
  have := congr_fun (congr_arg subtype.val h_eq) ⟨p,hfp⟩,
  rw [const_apply, const_apply, is_localization.eq] at this,
  cases this with r hr,
  exact ⟨r.1, hr, r.2⟩
end

/-
Auxiliary lemma for surjectivity of `to_basic_open`.
Every section can locally be represented on basic opens `basic_opens g` as a fraction `f/g`
-/
lemma locally_const_basic_open (U : opens (prime_spectrum.Top R))
  (s : (structure_sheaf R).1.obj (op U)) (x : U) :
  ∃ (f g : R) (i : basic_open g ⟶ U), x.1 ∈ basic_open g ∧
    const R f g (basic_open g) (λ y hy, hy) = (structure_sheaf R).1.map i.op s :=
begin
  -- First, any section `s` can be represented as a fraction `f/g` on some open neighborhood of `x`
  -- and we may pass to a `basic_open h`, since these form a basis
  obtain ⟨V, (hxV : x.1 ∈ V.1), iVU, f, g, (hVDg : V ⊆ basic_open g), s_eq⟩ :=
    exists_const R U s x.1 x.2,
  obtain ⟨_, ⟨h, rfl⟩, hxDh, (hDhV : basic_open h ⊆ V)⟩ :=
    is_topological_basis_basic_opens.exists_subset_of_mem_open hxV V.2,
  -- The problem is of course, that `g` and `h` don't need to coincide.
  -- But, since `basic_open h ≤ basic_open g`, some power of `h` must be a multiple of `g`
  cases (basic_open_le_basic_open_iff h g).mp (set.subset.trans hDhV hVDg) with n hn,
  -- Actually, we will need a *nonzero* power of `h`.
  -- This is because we will need the equality `basic_open (h ^ n) = basic_open h`, which only
  -- holds for a nonzero power `n`. We therefore artificially increase `n` by one.
  replace hn := ideal.mul_mem_left (ideal.span {g}) h hn,
  rw [← pow_succ, ideal.mem_span_singleton'] at hn,
  cases hn with c hc,
  have basic_opens_eq := basic_open_pow h (n+1) (by linarith),
  have i_basic_open := eq_to_hom basic_opens_eq ≫ hom_of_le hDhV,
  -- We claim that `(f * c) / h ^ (n+1)` is our desired representation
  use [f * c, h ^ (n+1), i_basic_open ≫ iVU, (basic_opens_eq.symm.le : _) hxDh],
  rw [op_comp, functor.map_comp, comp_apply, ← s_eq, res_const],
  -- Note that the last rewrite here generated an additional goal, which was a parameter
  -- of `res_const`. We prove this goal first
  swap,
  { intros y hy,
    rw basic_opens_eq at hy,
    exact (set.subset.trans hDhV hVDg : _) hy },
  -- All that is left is a simple calculation
  apply const_ext,
  rw [mul_assoc f c g, hc],
end

/-
Auxiliary lemma for surjectivity of `to_basic_open`.
A local representation of a section `s` as fractions `a i / h i` on finitely many basic opens
`basic_open (h i)` can be "normalized" in such a way that `a i * h j = h i * a j` for all `i, j`
-/
lemma normalize_finite_fraction_representation (U : opens (prime_spectrum.Top R))
  (s : (structure_sheaf R).1.obj (op U)) {ι : Type*} (t : finset ι) (a h : ι → R)
  (iDh : Π i : ι, basic_open (h i) ⟶ U)  (h_cover : U.1 ⊆ ⋃ i ∈ t, (basic_open (h i)).1)
  (hs : ∀ i : ι, const R (a i) (h i) (basic_open (h i)) (λ y hy, hy) =
    (structure_sheaf R).1.map (iDh i).op s) :
  ∃ (a' h' : ι → R) (iDh' : Π i : ι, (basic_open (h' i)) ⟶ U),
    (U.1 ⊆ ⋃ i ∈ t, (basic_open (h' i)).1) ∧
    (∀ i j ∈ t, a' i * h' j = h' i * a' j) ∧
    (∀ i ∈ t, (structure_sheaf R).1.map (iDh' i).op s =
      const R (a' i) (h' i) (basic_open (h' i)) (λ y hy, hy)) :=
begin
  -- First we show that the fractions `(a i * h j) / (h i * h j)` and `(h i * a j) / (h i * h j)`
  -- coincide in the localization of `R` at `h i * h j`
  have fractions_eq : ∀ (i j : ι),
    is_localization.mk' (localization.away _) (a i * h j) ⟨h i * h j, submonoid.mem_powers _⟩ =
    is_localization.mk' _ (h i * a j) ⟨h i * h j, submonoid.mem_powers _⟩,
  { intros i j,
    let D := basic_open (h i * h j),
    let iDi : D ⟶ basic_open (h i) := hom_of_le (basic_open_mul_le_left _ _),
    let iDj : D ⟶ basic_open (h j) := hom_of_le (basic_open_mul_le_right _ _),
    -- Crucially, we need injectivity of `to_basic_open`
    apply to_basic_open_injective R (h i * h j),
    rw [to_basic_open_mk', to_basic_open_mk'],
    simp only [set_like.coe_mk],
    -- Here, both sides of the equation are equal to a restriction of `s`
    transitivity,
    convert congr_arg ((structure_sheaf R).1.map iDj.op) (hs j).symm using 1,
    convert congr_arg ((structure_sheaf R).1.map iDi.op) (hs i) using 1, swap,
    all_goals { rw res_const, apply const_ext, ring },
    -- The remaining two goals were generated during the rewrite of `res_const`
    -- These can be solved immediately
    exacts [basic_open_mul_le_right _ _, basic_open_mul_le_left _ _] },

  -- From the equality in the localization, we obtain for each `(i,j)` some power `(h i * h j) ^ n`
  -- which equalizes `a i * h j` and `h i * a j`
  have exists_power : ∀ (i j : ι), ∃ n : ℕ,
    a i * h j * (h i * h j) ^ n = h i * a j * (h i * h j) ^ n,
  { intros i j,
    obtain ⟨⟨c, n, rfl⟩, hc⟩ := is_localization.eq.mp (fractions_eq i j),
    use (n+1),
    rw pow_succ,
    dsimp at hc,
    convert hc using 1 ; ring },
  let n := λ (p : ι × ι), (exists_power p.1 p.2).some,
  have n_spec := λ (p : ι × ι), (exists_power p.fst p.snd).some_spec,
  -- We need one power `(h i * h j) ^ N` that works for *all* pairs `(i,j)`
  -- Since there are only finitely many indices involved, we can pick the supremum.
  let N := (t.product t).sup n,
  have basic_opens_eq : ∀ i : ι, basic_open ((h i) ^ (N+1)) = basic_open (h i) :=
    λ i, basic_open_pow _ _ (by linarith),
  -- Expanding the fraction `a i / h i` by the power `(h i) ^ N` gives the desired normalization
  refine ⟨(λ i, a i * (h i) ^ N), (λ i, (h i) ^ (N + 1)),
    (λ i, eq_to_hom (basic_opens_eq i) ≫ iDh i), _, _, _⟩,
  { simpa only [basic_opens_eq] using h_cover },
  { intros i j hi hj,
    -- Here we need to show that our new fractions `a i / h i` satisfy the normalization condition
    -- Of course, the power `N` we used to expand the fractions might be bigger than the power
    -- `n (i, j)` which was originally chosen. We denote their difference by `k`
    have n_le_N : n (i, j) ≤ N := finset.le_sup (finset.mem_product.mpr ⟨hi, hj⟩),
    cases nat.le.dest n_le_N with k hk,
    simp only [← hk, pow_add, pow_one],
    -- To accommodate for the difference `k`, we multiply both sides of the equation `n_spec (i, j)`
    -- by `(h i * h j) ^ k`
    convert congr_arg (λ z, z * (h i * h j) ^ k) (n_spec (i, j)) using 1 ;
    { simp only [n, mul_pow], ring } },

  -- Lastly, we need to show that the new fractions still represent our original `s`
  intros i hi,
  rw [op_comp, functor.map_comp, comp_apply, ← hs, res_const],
  -- additional goal spit out by `res_const`
  swap, exact (basic_opens_eq i).le,
  apply const_ext,
  rw pow_succ,
  ring
end

open_locale classical
open_locale big_operators

-- The proof here follows the argument in Hartshorne's Algebraic Geometry, Proposition II.2.2.
lemma to_basic_open_surjective (f : R) : function.surjective (to_basic_open R f) :=
begin
  intro s,
  -- In this proof, `basic_open f` will play two distinct roles: Firstly, it is an open set in the
  -- prime spectrum. Secondly, it is used as an indexing type for various families of objects
  -- (open sets, ring elements, ...). In order to make the distinction clear, we introduce a type
  -- alias `ι` that is used whenever we want think of it as an indexing type.
  let ι : Type u := basic_open f,

  -- First, we pick some cover of basic opens, on which we can represent `s` as a fraction
  choose a' h' iDh' hxDh' s_eq' using locally_const_basic_open R (basic_open f) s,
  -- Since basic opens are compact, we can pass to a finite subcover
  obtain ⟨t, ht_cover'⟩ := (is_compact_basic_open f).elim_finite_subcover
   (λ (i : ι), (basic_open (h' i)).1) (λ i, is_open_basic_open) (λ x hx, _),
  swap,
  { -- Here, we need to show that our basic opens actually form a cover of `basic_open f`
    rw set.mem_Union,
    exact ⟨⟨x,hx⟩, hxDh' ⟨x, hx⟩⟩ },
  -- We use the normalization lemma from above to obtain the relation `a i * h j = h i * a j`
  obtain ⟨a, h, iDh, ht_cover, ah_ha, s_eq⟩ := normalize_finite_fraction_representation R
    (basic_open f) s t a' h' iDh' ht_cover' s_eq',
  clear s_eq' iDh' hxDh' ht_cover' a' h',
  -- Next we show that some power of `f` is a linear combination of the `h i`
  obtain ⟨n, hn⟩ : f ∈ (ideal.span (h '' ↑t)).radical,
  { rw [← vanishing_ideal_zero_locus_eq_radical, zero_locus_span],
    simp_rw [subtype.val_eq_coe, basic_open_eq_zero_locus_compl] at ht_cover,
    rw set.compl_subset_comm at ht_cover, -- Why doesn't `simp_rw` do this?
    simp_rw [set.compl_Union, compl_compl, ← zero_locus_Union, ← finset.set_bUnion_coe,
             ← set.image_eq_Union ] at ht_cover,
    apply vanishing_ideal_anti_mono ht_cover,
    exact subset_vanishing_ideal_zero_locus {f} (set.mem_singleton f) },

  replace hn := ideal.mul_mem_left _ f hn,
  erw [←pow_succ, finsupp.mem_span_image_iff_total] at hn,
  rcases hn with ⟨b, b_supp, hb⟩,
  rw finsupp.total_apply_of_mem_supported R b_supp at hb,
  dsimp at hb,

  -- Finally, we have all the ingredients.
  -- We claim that our preimage is given by `(∑ (i : ι) in t, b i * a i) / f ^ (n+1)`
  use is_localization.mk' (localization.away f) (∑ (i : ι) in t, b i * a i)
    (⟨f ^ (n+1), n+1, rfl⟩ : submonoid.powers _),
  rw to_basic_open_mk',

  -- Since the structure sheaf is a sheaf, we can show the desired equality locally.
  -- Annoyingly, `sheaf.eq_of_locally_eq` requires an open cover indexed by a *type*, so we need to
  -- coerce our finset `t` to a type first.
  let tt := ((t : set (basic_open f)) : Type u),
  apply (structure_sheaf R).eq_of_locally_eq'
    (λ i : tt, basic_open (h i)) (basic_open f) (λ i : tt, iDh i),
  { -- This feels a little redundant, since already have `ht_cover` as a hypothesis
    -- Unfortunately, `ht_cover` uses a bounded union over the set `t`, while here we have the
    -- Union indexed by the type `tt`, so we need some boilerplate to translate one to the other
    intros x hx,
    erw topological_space.opens.mem_supr,
    have := ht_cover hx,
    rw [← finset.set_bUnion_coe, set.mem_bUnion_iff] at this,
    rcases this with ⟨i, i_mem, x_mem⟩,
    use [i, i_mem] },

  rintro ⟨i, hi⟩,
  dsimp,
  change (structure_sheaf R).1.map _ _ = (structure_sheaf R).1.map _ _,
  rw [s_eq i hi, res_const],
  -- Again, `res_const` spits out an additional goal
  swap,
  { intros y hy,
    change y ∈ basic_open (f ^ (n+1)),
    rw basic_open_pow f (n+1) (by linarith),
    exact (le_of_hom (iDh i) : _) hy },
  -- The rest of the proof is just computation
  apply const_ext,
  rw [← hb, finset.sum_mul, finset.mul_sum],
  apply finset.sum_congr rfl,
  intros j hj,
  rw [mul_assoc, ah_ha j i hj hi],
  ring
end

instance is_iso_to_basic_open (f : R) : is_iso (show CommRing.of _ ⟶ _, from to_basic_open R f) :=
begin
  haveI : is_iso ((forget CommRing).map (show CommRing.of _ ⟶ _, from to_basic_open R f)) :=
    (is_iso_iff_bijective _).mpr ⟨to_basic_open_injective R f, to_basic_open_surjective R f⟩,
  exact is_iso_of_reflects_iso _ (forget CommRing),
end

/-- The ring isomorphism between the structure sheaf on `basic_open f` and the localization of `R`
at the submonoid of powers of `f`. -/
def basic_open_iso (f : R) : (structure_sheaf R).1.obj (op (basic_open f)) ≅
  CommRing.of (localization.away f) :=
(as_iso (show CommRing.of _ ⟶ _, from to_basic_open R f)).symm

@[elementwise] lemma to_global_factors : to_open R ⊤ =
  (CommRing.of_hom (algebra_map R (localization.away (1 : R)))) ≫ (to_basic_open R (1 : R)) ≫
  (structure_sheaf R).1.map (eq_to_hom (basic_open_one.symm)).op :=
begin
  change to_open R ⊤ = (to_basic_open R 1).comp _ ≫ _,
  unfold CommRing.of_hom,
  rw [localization_to_basic_open R, to_open_res],
end

instance is_iso_to_global : is_iso (to_open R ⊤) :=
begin
  let hom := CommRing.of_hom (algebra_map R (localization.away (1 : R))),
  haveI : is_iso hom := is_iso.of_iso
    ((is_localization.at_one R (localization.away (1 : R))).to_ring_equiv.to_CommRing_iso),
  rw to_global_factors R,
  apply_instance
end

/-- The ring isomorphism between the ring `R` and the global sections `Γ(X, 𝒪ₓ)`. -/
@[simps] def global_sections_iso : CommRing.of R ≅ (structure_sheaf R).1.obj (op ⊤) :=
as_iso (to_open R ⊤)

@[simp] lemma global_sections_iso_hom (R : CommRing) :
  (global_sections_iso R).hom = to_open R ⊤ := rfl

section comap

variables {R} {S : Type u} [comm_ring S] {P : Type u} [comm_ring P]

/--
Given a ring homomorphism `f : R →+* S`, an open set `U` of the prime spectrum of `R` and an open
set `V` of the prime spectrum of `S`, such that `V ⊆ (comap f) ⁻¹' U`, we can push a section `s`
on `U` to a section on `V`, by composing with `localization.local_ring_hom _ _ f` from the left and
`comap f` from the right. Explicitly, if `s` evaluates on `comap f p` to `a / b`, its image on `V`
evaluates on `p` to `f(a) / f(b)`.

At the moment, we work with arbitrary dependent functions `s : Π x : U, localizations R x`. Below,
we prove the predicate `is_locally_fraction` is preserved by this map, hence it can be extended to
a morphism between the structure sheaves of `R` and `S`.
-/
def comap_fun (f : R →+* S) (U : opens (prime_spectrum.Top R))
  (V : opens (prime_spectrum.Top S)) (hUV : V.1 ⊆ (prime_spectrum.comap f) ⁻¹' U.1)
  (s : Π x : U, localizations R x) (y : V) : localizations S y :=
localization.local_ring_hom (prime_spectrum.comap f y.1).as_ideal _ f rfl
  (s ⟨(prime_spectrum.comap f y.1), hUV y.2⟩ : _)

lemma comap_fun_is_locally_fraction (f : R →+* S)
  (U : opens (prime_spectrum.Top R)) (V : opens (prime_spectrum.Top S))
  (hUV : V.1 ⊆ (prime_spectrum.comap f) ⁻¹' U.1) (s : Π x : U, localizations R x)
  (hs : (is_locally_fraction R).to_prelocal_predicate.pred s) :
  (is_locally_fraction S).to_prelocal_predicate.pred (comap_fun f U V hUV s) :=
begin
  rintro ⟨p, hpV⟩,
  -- Since `s` is locally fraction, we can find a neighborhood `W` of `prime_spectrum.comap f p`
  -- in `U`, such that `s = a / b` on `W`, for some ring elements `a, b : R`.
  rcases hs ⟨prime_spectrum.comap f p, hUV hpV⟩ with ⟨W, m, iWU, a, b, h_frac⟩,
  -- We claim that we can write our new section as the fraction `f a / f b` on the neighborhood
  -- `(comap f) ⁻¹ W ⊓ V` of `p`.
  refine ⟨opens.comap (comap f) W ⊓ V, ⟨m, hpV⟩, opens.inf_le_right _ _, f a, f b, _⟩,
  rintro ⟨q, ⟨hqW, hqV⟩⟩,
  specialize h_frac ⟨prime_spectrum.comap f q, hqW⟩,
  refine ⟨h_frac.1, _⟩,
  dsimp only [comap_fun],
  erw [← localization.local_ring_hom_to_map ((prime_spectrum.comap f q).as_ideal),
    ← ring_hom.map_mul, h_frac.2, localization.local_ring_hom_to_map],
  refl,
end

/--
For a ring homomorphism `f : R →+* S` and open sets `U` and `V` of the prime spectra of `R` and
`S` such that `V ⊆ (comap f) ⁻¹ U`, the induced ring homomorphism from the structure sheaf of `R`
at `U` to the structure sheaf of `S` at `V`.

Explicitly, this map is given as follows: For a point `p : V`, if the section `s` evaluates on `p`
to the fraction `a / b`, its image on `V` evaluates on `p` to the fraction `f(a) / f(b)`.
-/
def comap (f : R →+* S) (U : opens (prime_spectrum.Top R))
  (V : opens (prime_spectrum.Top S)) (hUV : V.1 ⊆ (prime_spectrum.comap f) ⁻¹' U.1) :
  (structure_sheaf R).1.obj (op U) →+* (structure_sheaf S).1.obj (op V) :=
{ to_fun := λ s, ⟨comap_fun f U V hUV s.1, comap_fun_is_locally_fraction f U V hUV s.1 s.2⟩,
  map_one' := subtype.ext $ funext $ λ p, by
    { rw [subtype.coe_mk, subtype.val_eq_coe, comap_fun, (sections_subring R (op U)).coe_one,
      pi.one_apply, ring_hom.map_one], refl },
  map_zero' := subtype.ext $ funext $ λ p, by
    { rw [subtype.coe_mk, subtype.val_eq_coe, comap_fun, (sections_subring R (op U)).coe_zero,
      pi.zero_apply, ring_hom.map_zero], refl },
  map_add' := λ s t, subtype.ext $ funext $ λ p, by
    { rw [subtype.coe_mk, subtype.val_eq_coe, comap_fun, (sections_subring R (op U)).coe_add,
      pi.add_apply, ring_hom.map_add], refl },
  map_mul' := λ s t, subtype.ext $ funext $ λ p, by
    { rw [subtype.coe_mk, subtype.val_eq_coe, comap_fun, (sections_subring R (op U)).coe_mul,
      pi.mul_apply, ring_hom.map_mul], refl } }

@[simp]
lemma comap_apply (f : R →+* S) (U : opens (prime_spectrum.Top R))
  (V : opens (prime_spectrum.Top S)) (hUV : V.1 ⊆ (prime_spectrum.comap f) ⁻¹' U.1)
  (s : (structure_sheaf R).1.obj (op U)) (p : V) :
  (comap f U V hUV s).1 p =
  localization.local_ring_hom (prime_spectrum.comap f p.1).as_ideal _ f rfl
    (s.1 ⟨(prime_spectrum.comap f p.1), hUV p.2⟩ : _) :=
rfl

lemma comap_const (f : R →+* S) (U : opens (prime_spectrum.Top R))
  (V : opens (prime_spectrum.Top S)) (hUV : V.1 ⊆ (prime_spectrum.comap f) ⁻¹' U.1)
  (a b : R) (hb : ∀ x : prime_spectrum R, x ∈ U → b ∈ x.as_ideal.prime_compl) :
  comap f U V hUV (const R a b U hb) =
  const S (f a) (f b) V (λ p hpV, hb (prime_spectrum.comap f p) (hUV hpV)) :=
subtype.eq $ funext $ λ p,
begin
  rw [comap_apply, const_apply, const_apply],
  erw localization.local_ring_hom_mk',
  refl,
end

/--
For an inclusion `i : V ⟶ U` between open sets of the prime spectrum of `R`, the comap of the
identity from OO_X(U) to OO_X(V) equals as the restriction map of the structure sheaf.

This is a generalization of the fact that, for fixed `U`, the comap of the identity from OO_X(U)
to OO_X(U) is the identity.
-/
lemma comap_id_eq_map (U V : opens (prime_spectrum.Top R)) (iVU : V ⟶ U) :
  comap (ring_hom.id R) U V
    (λ p hpV, le_of_hom iVU $ by rwa prime_spectrum.comap_id) =
  (structure_sheaf R).1.map iVU.op :=
ring_hom.ext $ λ s, subtype.eq $ funext $ λ p,
begin
  rw comap_apply,
  -- Unfortunately, we cannot use `localization.local_ring_hom_id` here, because
  -- `prime_spectrum.comap (ring_hom.id R) p` is not *definitionally* equal to `p`. Instead, we use
  -- that we can write `s` as a fraction `a/b` in a small neighborhood around `p`. Since
  -- `prime_spectrum.comap (ring_hom.id R) p` equals `p`, it is also contained in the same
  -- neighborhood, hence `s` equals `a/b` there too.
  obtain ⟨W, hpW, iWU, h⟩ := s.2 (iVU p),
  obtain ⟨a, b, h'⟩ := h.eq_mk',
  obtain ⟨hb₁, s_eq₁⟩ := h' ⟨p, hpW⟩,
  obtain ⟨hb₂, s_eq₂⟩ := h' ⟨prime_spectrum.comap (ring_hom.id _) p.1,
    by rwa prime_spectrum.comap_id⟩,
  dsimp only at s_eq₁ s_eq₂,
  erw [s_eq₂, localization.local_ring_hom_mk', ← s_eq₁, ← res_apply],
end

/--
The comap of the identity is the identity. In this variant of the lemma, two open subsets `U` and
`V` are given as arguments, together with a proof that `U = V`. This is be useful when `U` and `V`
are not definitionally equal.
-/
lemma comap_id (U V : opens (prime_spectrum.Top R)) (hUV : U = V) :
  comap (ring_hom.id R) U V (λ p hpV, by rwa [hUV, prime_spectrum.comap_id]) =
  eq_to_hom (show (structure_sheaf R).1.obj (op U) = _, by rw hUV) :=
by erw [comap_id_eq_map U V (eq_to_hom hUV.symm), eq_to_hom_op, eq_to_hom_map]

@[simp] lemma comap_id' (U : opens (prime_spectrum.Top R)) :
  comap (ring_hom.id R) U U (λ p hpU, by rwa prime_spectrum.comap_id) =
  ring_hom.id _ :=
by { rw comap_id U U rfl, refl }

lemma comap_comp (f : R →+* S) (g : S →+* P) (U : opens (prime_spectrum.Top R))
  (V : opens (prime_spectrum.Top S)) (W : opens (prime_spectrum.Top P))
  (hUV : ∀ p ∈ V, prime_spectrum.comap f p ∈ U) (hVW : ∀ p ∈ W, prime_spectrum.comap g p ∈ V) :
  comap (g.comp f) U W (λ p hpW, hUV (prime_spectrum.comap g p) (hVW p hpW)) =
    (comap g V W hVW).comp (comap f U V hUV) :=
ring_hom.ext $ λ s, subtype.eq $ funext $ λ p,
begin
  rw comap_apply,
  erw localization.local_ring_hom_comp _ (prime_spectrum.comap g p.1).as_ideal,
  -- refl works here, because `prime_spectrum.comap (g.comp f) p` is defeq to
  -- `prime_spectrum.comap f (prime_spectrum.comap g p)`
  refl,
end

@[elementwise, reassoc] lemma to_open_comp_comap (f : R →+* S)
  (U : opens (prime_spectrum.Top R)) :
  to_open R U ≫ comap f U (opens.comap (prime_spectrum.comap f) U) (λ _, id) =
  CommRing.of_hom f ≫ to_open S _ :=
ring_hom.ext $ λ s, subtype.eq $ funext $ λ p,
begin
  simp_rw [comp_apply, comap_apply, subtype.val_eq_coe],
  erw localization.local_ring_hom_to_map,
  refl,
end

end comap

end structure_sheaf

end algebraic_geometry


import analysis.normed_space.inner_product data.complex.is_R_or_C tactic

open_locale big_operators

variables {𝕜 E ι: Type*} [is_R_or_C 𝕜]  [inner_product_space 𝕜 E] [complete_space E]

open is_R_or_C

include 𝕜

example (s : finset ι) (f : ι → E) : E :=  ∑ i in s, f i

example (y : E) : ∥y∥^2 = re (inner y y) := inner_product_space.norm_sq_eq_inner y

local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

variables (s : finset ι) (f : ι → E) (x : E)

example : E := x -  ∑ i in s, ⟪x, f i⟫ • (f i)

example : ℝ := ∥ x -  ∑ i in s, ⟪x, f i⟫ • (f i) ∥

example : ℝ := ∥ x -  ∑ i in s, ⟪x, f i⟫ • (f i) ∥^2

example :
  ∥ x -  ∑ i in s, ⟪x, f i⟫ • (f i) ∥^2 = re ⟪x -  ∑ i in s, ⟪x, f i⟫ • (f i), x -  ∑ i in s, ⟪x, f i⟫ • (f i)⟫ :=
by { apply inner_product_space.norm_sq_eq_inner }

example : 𝕜 := ∑ i in s, ⟪x, f i⟫

example : 𝕜 := ∑ i in s, ⟪x, ⟪x, f i⟫ • (f i)⟫

example : ℝ := ∑ i in s, re ⟪x, ⟪x, f i⟫ • (f i)⟫

example : ℝ := ∥x∥^2

example : ℝ := ∑ i in s, (re ⟪x, f i⟫)^2

example : ℝ := ∥x∥^2 - 2 * ∑ i in s, re ⟪x, ⟪x, f i⟫ • (f i)⟫

example : ℝ := ∥x∥^2 - 2 * ∑ i in s, re ⟪x, ⟪x, f i⟫ • (f i)⟫ + ∑ i in s, (re ⟪x, f i⟫)^2

example (a b : 𝕜) : re (a + b) = re a + re b := by rw add_monoid_hom.map_add

example (a b : 𝕜) : re (a + b) = re a + re b := add_monoid_hom.map_add _ _ _

example (a b : 𝕜) : re (a - b) = re a - re b := by rw add_monoid_hom.map_sub

example (a b : 𝕜) : re (a - b) = re a - re b := add_monoid_hom.map_sub _ _ _

lemma foo {a b c d : ℝ} : a - b - c + d = a - (b + c - d) := by linarith

example {a b c d : ℝ} : a - b - c + d = (a - b) - c + d := rfl

example {a b c d : ℝ} : a - b - c + d = ((a - b) - c) + d := rfl

example {a b c d : ℝ} : a - b - c + d = ((a - b) - c) + d := rfl

example {p q r : ℝ} : p - q + r = p - (q - r) := by rw sub_add

/- lemma bob : ∥ x -  ∑ i in s, ⟪x, f i⟫ • (f i) ∥^2 = ∥x∥^2 - ∑ i in s, (re ⟪x, f i⟫)^2 :=
begin
  conv_lhs { rw inner_product_space.norm_sq_eq_inner, },
  simp only [inner_sub_sub_self, add_monoid_hom.map_add, add_monoid_hom.map_sub],
  rw [←inner_product_space.norm_sq_eq_inner, sub_add, sub_sub],
  congr' 1,
  simp only [pow_two, finset.sum_congr],
end
 -/

omit 𝕜


/-
Copyright (c) 2021 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.adjunctions
import category_theory.epi_mono

/-!
# Monomorphisms in `Module R`

This file shows that an `R`-linear map is a monomorphism in the category of `R`-modules
if and only if it is injective, and similarly an epimorphism if and only if it is surjective.
-/

universes v u

open category_theory
open Module
open_locale Module

namespace Module

variables {R : Type u} [ring R] {X Y : Module.{v} R} (f : X ⟶ Y)

lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ :=
linear_map.ker_eq_bot_of_cancel $ λ u v, (@cancel_mono _ _ _ _ _ f _ ↟u ↟v).1

lemma range_eq_top_of_epi [epi f] : f.range = ⊤ :=
linear_map.range_eq_top_of_cancel $ λ u v, (@cancel_epi _ _ _ _ _ f _ ↟u ↟v).1

lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ :=
⟨λ hf, by exactI ker_eq_bot_of_mono _,
 λ hf, concrete_category.mono_of_injective _ $ linear_map.ker_eq_bot.1 hf⟩

lemma mono_iff_injective : mono f ↔ function.injective f :=
by rw [mono_iff_ker_eq_bot, linear_map.ker_eq_bot]

lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ :=
⟨λ hf, by exactI range_eq_top_of_epi _,
 λ hf, concrete_category.epi_of_surjective _ $ linear_map.range_eq_top.1 hf⟩

lemma epi_iff_surjective : epi f ↔ function.surjective f :=
by rw [epi_iff_range_eq_top, linear_map.range_eq_top]

instance mono_as_hom'_subtype (U : submodule R X) : mono ↾U.subtype :=
(mono_iff_ker_eq_bot _).mpr (submodule.ker_subtype U)

instance epi_as_hom''_mkq (U : submodule R X) : epi ↿U.mkq :=
(epi_iff_range_eq_top _).mpr $ submodule.range_mkq _

end Module


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.nat.interval

/-!
# Finite intervals in `fin n`

This file proves that `fin n` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset fin

variables (n : ℕ)

instance : locally_finite_order (fin n) := subtype.locally_finite_order _

namespace fin
section bounded
variables {n} (a b : fin n)

lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ x, x < n) := rfl

@[simp] lemma map_subtype_embedding_Icc :
  (Icc a b).map (function.embedding.subtype _) = Icc (a : ℕ) b :=
map_subtype_embedding_Icc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ico :
  (Ico a b).map (function.embedding.subtype _) = Ico (a : ℕ) b :=
map_subtype_embedding_Ico _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioc :
  (Ioc a b).map (function.embedding.subtype _) = Ioc (a : ℕ) b :=
map_subtype_embedding_Ioc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioo :
  (Ioo a b).map (function.embedding.subtype _) = Ioo (a : ℕ) b :=
map_subtype_embedding_Ioo _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map]

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [←nat.card_Ico, ←map_subtype_embedding_Ico, card_map]

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map]

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [←card_Ioo, fintype.card_of_finset]

end bounded

section unbounded
variables {n} (a b : fin (n + 1))

lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) :=
begin
  ext x,
  simp only [mem_subtype, mem_Ici, mem_Icc, coe_fin_le, iff_self_and],
  exact λ _, x.2.le,
end

lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) :=
begin
  ext x,
  simp only [mem_subtype, mem_Ioi, mem_Ioc, coe_fin_lt, iff_self_and],
  exact λ _, x.2.le,
end

lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).subtype (λ x, x < n + 1) := rfl
lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).subtype (λ x, x < n + 1) := rfl

@[simp] lemma map_subtype_embedding_Ici : (Ici a).map (function.embedding.subtype _) = Icc a n :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Ici, mem_map, mem_Icc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, nat.lt_succ_iff.1 x.2⟩ },
  { rintro hx,
    exact ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map (function.embedding.subtype _) = Ioc a n :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc],
  refine ⟨_, λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact ⟨hx, nat.lt_succ_iff.1 x.2⟩,
end

@[simp] lemma map_subtype_embedding_Iic : (Iic b).map (function.embedding.subtype _) = Iic b :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Iic, mem_map],
  refine ⟨_, λ hx, ⟨⟨x, hx.trans_lt b.2⟩, hx, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact hx,
end

@[simp] lemma map_subtype_embedding_Iio : (Iio b).map (function.embedding.subtype _) = Iio b :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Iio, mem_map],
  refine ⟨_, λ hx, ⟨⟨x, hx.trans b.2⟩, hx, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact hx,
end

@[simp] lemma card_Ici : (Ici a).card = n + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Ici, card_map]

@[simp] lemma card_Ioi : (Ioi a).card = n - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioi, card_map]

@[simp] lemma card_Iic : (Iic b).card = b + 1 :=
by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map]

@[simp] lemma card_Iio : (Iio b).card = b :=
by rw [←nat.card_Iio b, ←map_subtype_embedding_Iio, card_map]

@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n + 1 - a :=
by rw [fintype.card_of_finset, card_Ici]

@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - a :=
by rw [fintype.card_of_finset, card_Ioi]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

end unbounded
end fin


import logic.basic -- Needed for imp_false

section question2

variable R : Prop
variables S T : Prop
variable h : S ∧ T
variable h₁ : S → T
variable h₂ : S

end question2

section question5

variables P Q : Prop

example : ¬P ∨ ¬Q → ¬(P ∧ Q) :=
begin
  intros h₁ h₂, -- you can introduce off a ¬
  -- have h₃ : P, from h₂.1,
  -- have h₄ : Q, from h₂.2,
  cases h₁ with h₅ h₆, -- you can use cases to split an ∨
  { --apply h₅, exact h₃,
    exact h₅ h₂.1}, -- you can use dot notation to point at the part of the ∧
  { -- apply h₆, exact h₄,
    exact h₆ h₂.2}, -- you can compact `apply` `exact` into just `exact`.
end

end question5

section question8

variables N S I : Prop

open classical
local attribute [instance] prop_decidable

#check imp_false.mpr

example (h₁ : N ↔ (S ↔ I)) (h₂ : I ↔ S) (h₃ : S ↔ ¬N) : N ∧ (¬S ∧ ¬I) :=
begin
  by_cases h₄ : S,
  { exfalso,
    apply imp_false.mpr,
    { rw h₃ at h₄,
      apply h₄},
    { rw [h₂, iff_self, iff_true] at h₁,
      exact h₁,
    },
  },
  {
    sorry},
end

example (h₁ : N ↔ (S ↔ I)) (h₂ : I ↔ S) (h₃ : S ↔ ¬N) : N ∧ (¬S ∧ ¬I) :=
begin
  by_cases h₄ : S,
  { exfalso,
    apply imp_false.mpr,
    { rw h₃ at h₄,
      exact h₄, },
    { rw [h₁, ←h₂], },
    },
  { have h₅ : N,
    { rw [h₁, ←h₂], },
    have h₆ : ¬I,
    { rwa h₂, },
    exact ⟨h₅, h₄, h₆⟩, },
end

end question8