/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.modeq
import Mathlib.algebra.char_p.basic
import Mathlib.data.nat.totient
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Integers mod `n`

Definition of the integers mod n, and the field structure on the integers mod p.

## Definitions

* `zmod n`, which is for integers modulo a nat `n : ℕ`

* `val a` is defined as a natural number:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

* `val_min_abs` returns the integer closest to zero in the equivalence class.

* A coercion `cast` is defined from `zmod n` into any ring.
This is a ring hom if the ring has characteristic dividing `n`

-/

namespace fin

/-!
## Ring structure on `fin n`

We define a commutative ring structure on `fin n`, but we do not register it as instance.
Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
to register the ring structure on `zmod n` as type class instance.
-/

/-- Negation on `fin n` -/
def has_neg (n : ℕ) : Neg (fin n) :=
  { neg := fun (a : fin n) => { val := int.nat_mod (-↑(subtype.val a)) ↑n, property := sorry } }

/-- Multiplicative commutative semigroup structure on `fin (n+1)`. -/
def comm_semigroup (n : ℕ) : comm_semigroup (fin (n + 1)) :=
  comm_semigroup.mk Mul.mul sorry sorry

/-- Commutative ring structure on `fin (n+1)`. -/
def comm_ring (n : ℕ) : comm_ring (fin (n + 1)) :=
  comm_ring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg
    (ring.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg) sorry sorry comm_semigroup.mul
    sorry 1 fin.one_mul fin.mul_one (left_distrib_aux n) sorry sorry

end fin

/-- The integers modulo `n : ℕ`. -/
def zmod : ℕ → Type :=
  sorry

namespace zmod

protected instance fintype (n : ℕ) [fact (0 < n)] : fintype (zmod n) :=
  sorry

theorem card (n : ℕ) [fact (0 < n)] : fintype.card (zmod n) = n :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) => fintype.card_fin (n + 1)) _inst_1

protected instance decidable_eq (n : ℕ) : DecidableEq (zmod n) :=
  sorry

protected instance has_repr (n : ℕ) : has_repr (zmod n) :=
  sorry

protected instance comm_ring (n : ℕ) : comm_ring (zmod n) :=
  sorry

protected instance inhabited (n : ℕ) : Inhabited (zmod n) :=
  { default := 0 }

/-- `val a` is a natural number defined as:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

See `zmod.val_min_abs` for a variant that takes values in the integers.
-/
def val {n : ℕ} : zmod n → ℕ :=
  sorry

theorem val_lt {n : ℕ} [fact (0 < n)] (a : zmod n) : val a < n :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] (a : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (a : zmod (Nat.succ n)) => fin.is_lt a) _inst_1 a

@[simp] theorem val_zero {n : ℕ} : val 0 = 0 :=
  nat.cases_on n (idRhs (val 0 = val 0) rfl) fun (n : ℕ) => idRhs (val 0 = val 0) rfl

theorem val_cast_nat {n : ℕ} (a : ℕ) : val ↑a = a % n := sorry

protected instance char_p (n : ℕ) : char_p (zmod n) n := sorry

@[simp] theorem cast_self (n : ℕ) : ↑n = 0 :=
  char_p.cast_eq_zero (zmod n) n

@[simp] theorem cast_self' (n : ℕ) : ↑n + 1 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n + 1 = 0)) (Eq.symm (nat.cast_add_one n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(n + 1) = 0)) (cast_self (n + 1)))) (Eq.refl 0))

/-- Cast an integer modulo `n` to another semiring.
This function is a morphism if the characteristic of `R` divides `n`.
See `zmod.cast_hom` for a bundled version. -/
def cast {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] {n : ℕ} : zmod n → R :=
  sorry

-- see Note [coercion into rings]

protected instance has_coe_t {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] (n : ℕ) : has_coe_t (zmod n) R :=
  has_coe_t.mk cast

@[simp] theorem cast_zero {n : ℕ} {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] : ↑0 = 0 :=
  nat.cases_on n (Eq.refl ↑0) fun (n : ℕ) => Eq.refl ↑0

theorem nat_cast_surjective {n : ℕ} [fact (0 < n)] : function.surjective coe := sorry

theorem int_cast_surjective {n : ℕ} : function.surjective coe := sorry

theorem cast_val {n : ℕ} [fact (0 < n)] (a : zmod n) : ↑(val a) = a := sorry

@[simp] theorem cast_id (n : ℕ) (i : zmod n) : ↑i = i :=
  nat.cases_on n (fun (i : zmod 0) => idRhs (↑i = i) (int.cast_id i))
    (fun (n : ℕ) (i : zmod (Nat.succ n)) => idRhs (↑(val i) = i) (cast_val i)) i

@[simp] theorem nat_cast_val {n : ℕ} {R : Type u_1} [ring R] [fact (0 < n)] (i : zmod n) : ↑(val i) = ↑i :=
  nat.cases_on n (fun [_inst_2 : fact (0 < 0)] (i : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_2))
    (fun (n : ℕ) (i : zmod (Nat.succ n)) => Eq.refl ↑(val i)) _inst_2 i

/-! If the characteristic of `R` divides `n`, then `cast` is a homomorphism. -/

@[simp] theorem cast_one {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) : ↑1 = 1 := sorry

theorem cast_add {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n) (b : zmod n) : ↑(a + b) = ↑a + ↑b := sorry

theorem cast_mul {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n) (b : zmod n) : ↑(a * b) = ↑a * ↑b := sorry

/-- The canonical ring homomorphism from `zmod n` to a ring of characteristic `n`. -/
def cast_hom {n : ℕ} {m : ℕ} (h : m ∣ n) (R : Type u_1) [ring R] [char_p R m] : zmod n →+* R :=
  ring_hom.mk coe (cast_one h) (cast_mul h) sorry (cast_add h)

@[simp] theorem cast_hom_apply {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] {h : m ∣ n} (i : zmod n) : coe_fn (cast_hom h R) i = ↑i :=
  rfl

@[simp] theorem cast_sub {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n) (b : zmod n) : ↑(a - b) = ↑a - ↑b :=
  ring_hom.map_sub (cast_hom h R) a b

@[simp] theorem cast_neg {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n) : ↑(-a) = -↑a :=
  ring_hom.map_neg (cast_hom h R) a

@[simp] theorem cast_pow {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n) (k : ℕ) : ↑(a ^ k) = ↑a ^ k :=
  ring_hom.map_pow (cast_hom h R) a k

@[simp] theorem cast_nat_cast {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (k : ℕ) : ↑↑k = ↑k :=
  ring_hom.map_nat_cast (cast_hom h R) k

@[simp] theorem cast_int_cast {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (k : ℤ) : ↑↑k = ↑k :=
  ring_hom.map_int_cast (cast_hom h R) k

/-! Some specialised simp lemmas which apply when `R` has characteristic `n`. -/

@[simp] theorem cast_one' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] : ↑1 = 1 :=
  cast_one (dvd_refl n)

@[simp] theorem cast_add' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) : ↑(a + b) = ↑a + ↑b :=
  cast_add (dvd_refl n) a b

@[simp] theorem cast_mul' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) : ↑(a * b) = ↑a * ↑b :=
  cast_mul (dvd_refl n) a b

@[simp] theorem cast_sub' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) : ↑(a - b) = ↑a - ↑b :=
  cast_sub (dvd_refl n) a b

@[simp] theorem cast_pow' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (k : ℕ) : ↑(a ^ k) = ↑a ^ k :=
  cast_pow (dvd_refl n) a k

@[simp] theorem cast_nat_cast' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (k : ℕ) : ↑↑k = ↑k :=
  cast_nat_cast (dvd_refl n) k

@[simp] theorem cast_int_cast' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (k : ℤ) : ↑↑k = ↑k :=
  cast_int_cast (dvd_refl n) k

protected instance algebra {n : ℕ} (R : Type u_1) [comm_ring R] [char_p R n] : algebra (zmod n) R :=
  ring_hom.to_algebra (cast_hom (dvd_refl n) R)

theorem cast_hom_injective {n : ℕ} (R : Type u_1) [ring R] [char_p R n] : function.injective ⇑(cast_hom (dvd_refl n) R) := sorry

theorem cast_hom_bijective {n : ℕ} (R : Type u_1) [ring R] [char_p R n] [fintype R] (h : fintype.card R = n) : function.bijective ⇑(cast_hom (dvd_refl n) R) := sorry

/-- The unique ring isomorphism between `zmod n` and a ring `R`
of characteristic `n` and cardinality `n`. -/
def ring_equiv {n : ℕ} (R : Type u_1) [ring R] [char_p R n] [fintype R] (h : fintype.card R = n) : zmod n ≃+* R :=
  ring_equiv.of_bijective (cast_hom (dvd_refl n) R) (cast_hom_bijective R h)

theorem int_coe_eq_int_coe_iff (a : ℤ) (b : ℤ) (c : ℕ) : ↑a = ↑b ↔ int.modeq (↑c) a b :=
  char_p.int_coe_eq_int_coe_iff (zmod c) c a b

theorem nat_coe_eq_nat_coe_iff (a : ℕ) (b : ℕ) (c : ℕ) : ↑a = ↑b ↔ nat.modeq c a b := sorry

theorem int_coe_zmod_eq_zero_iff_dvd (a : ℤ) (b : ℕ) : ↑a = 0 ↔ ↑b ∣ a := sorry

theorem nat_coe_zmod_eq_zero_iff_dvd (a : ℕ) (b : ℕ) : ↑a = 0 ↔ b ∣ a := sorry

@[simp] theorem cast_mod_int (a : ℤ) (b : ℕ) : ↑(a % ↑b) = ↑a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(a % ↑b) = ↑a)) (propext (int_coe_eq_int_coe_iff (a % ↑b) a b))))
    (int.modeq.mod_modeq a ↑b)

@[simp] theorem coe_to_nat (p : ℕ) {z : ℤ} (h : 0 ≤ z) : ↑(int.to_nat z) = ↑z := sorry

theorem val_injective (n : ℕ) [fact (0 < n)] : function.injective val :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] => id fun (a₁ : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) => id fun (a b : zmod (Nat.succ n)) (h : val a = val b) => fin.ext h) _inst_1

theorem val_one_eq_one_mod (n : ℕ) : val 1 = 1 % n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val 1 = 1 % n)) (Eq.symm nat.cast_one)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (val ↑1 = 1 % n)) (val_cast_nat 1))) (Eq.refl (1 % n)))

theorem val_one (n : ℕ) [fact (1 < n)] : val 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val 1 = 1)) (val_one_eq_one_mod n))) (nat.mod_eq_of_lt _inst_1)

theorem val_add {n : ℕ} [fact (0 < n)] (a : zmod n) (b : zmod n) : val (a + b) = (val a + val b) % n :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] (a b : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (a b : zmod (Nat.succ n)) => fin.val_add a b) _inst_1 a b

theorem val_mul {n : ℕ} (a : zmod n) (b : zmod n) : val (a * b) = val a * val b % n := sorry

protected instance nontrivial (n : ℕ) [fact (1 < n)] : nontrivial (zmod n) :=
  nontrivial.mk
    (Exists.intro 0
      (Exists.intro 1
        fun (h : 0 = 1) =>
          zero_ne_one
            (Eq.trans (Eq.trans (eq.mpr (id (Eq._oldrec (Eq.refl (0 = val 0)) val_zero)) (Eq.refl 0)) (congr_arg val h))
              (val_one n))))

/-- The inversion on `zmod n`.
It is setup in such a way that `a * a⁻¹` is equal to `gcd a.val n`.
In particular, if `a` is coprime to `n`, and hence a unit, `a * a⁻¹ = 1`. -/
def inv (n : ℕ) : zmod n → zmod n :=
  sorry

protected instance has_inv (n : ℕ) : has_inv (zmod n) :=
  has_inv.mk (inv n)

theorem inv_zero (n : ℕ) : 0⁻¹ = 0 := sorry

theorem mul_inv_eq_gcd {n : ℕ} (a : zmod n) : a * (a⁻¹) = ↑(nat.gcd (val a) n) := sorry

@[simp] theorem cast_mod_nat (n : ℕ) (a : ℕ) : ↑(a % n) = ↑a := sorry

theorem eq_iff_modeq_nat (n : ℕ) {a : ℕ} {b : ℕ} : ↑a = ↑b ↔ nat.modeq n a b := sorry

theorem coe_mul_inv_eq_one {n : ℕ} (x : ℕ) (h : nat.coprime x n) : ↑x * (↑x⁻¹) = 1 := sorry

/-- `unit_of_coprime` makes an element of `units (zmod n)` given
  a natural number `x` and a proof that `x` is coprime to `n`  -/
def unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) : units (zmod n) :=
  units.mk (↑x) (↑x⁻¹) (coe_mul_inv_eq_one x h) sorry

@[simp] theorem cast_unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) : ↑(unit_of_coprime x h) = ↑x :=
  rfl

theorem val_coe_unit_coprime {n : ℕ} (u : units (zmod n)) : nat.coprime (val ↑u) n := sorry

@[simp] theorem inv_coe_unit {n : ℕ} (u : units (zmod n)) : ↑u⁻¹ = ↑(u⁻¹) := sorry

theorem mul_inv_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) : a * (a⁻¹) = 1 := sorry

theorem inv_mul_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) : a⁻¹ * a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * a = 1)) (mul_comm (a⁻¹) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹) = 1)) (mul_inv_of_unit a h))) (Eq.refl 1))

/-- Equivalence between the units of `zmod n` and
the subtype of terms `x : zmod n` for which `x.val` is comprime to `n` -/
def units_equiv_coprime {n : ℕ} [fact (0 < n)] : units (zmod n) ≃ Subtype fun (x : zmod n) => nat.coprime (val x) n :=
  equiv.mk (fun (x : units (zmod n)) => { val := ↑x, property := val_coe_unit_coprime x })
    (fun (x : Subtype fun (x : zmod n) => nat.coprime (val x) n) => unit_of_coprime (val (subtype.val x)) sorry) sorry
    sorry

@[simp] theorem card_units_eq_totient (n : ℕ) [fact (0 < n)] : fintype.card (units (zmod n)) = nat.totient n := sorry

protected instance subsingleton_units : subsingleton (units (zmod (bit0 1))) :=
  subsingleton.intro
    fun (x y : units (zmod (bit0 1))) =>
      units.cases_on x
        fun (x xi : zmod (bit0 1)) (x_val_inv : x * xi = 1) (x_inv_val : xi * x = 1) =>
          units.cases_on y
            fun (y yi : zmod (bit0 1)) (y_val_inv : y * yi = 1) (y_inv_val : yi * y = 1) =>
              of_as_true trivial x y xi yi x_val_inv x_inv_val y_val_inv y_inv_val

theorem le_div_two_iff_lt_neg (n : ℕ) [hn : fact (n % bit0 1 = 1)] {x : zmod n} (hx0 : x ≠ 0) : val x ≤ n / bit0 1 ↔ n / bit0 1 < val (-x) := sorry

theorem ne_neg_self (n : ℕ) [hn : fact (n % bit0 1 = 1)] {a : zmod n} (ha : a ≠ 0) : a ≠ -a := sorry

theorem neg_one_ne_one {n : ℕ} [fact (bit0 1 < n)] : -1 ≠ 1 :=
  char_p.neg_one_ne_one (zmod n) n

@[simp] theorem neg_eq_self_mod_two (a : zmod (bit0 1)) : -a = a :=
  of_as_true trivial

@[simp] theorem nat_abs_mod_two (a : ℤ) : ↑(int.nat_abs a) = ↑a := sorry

@[simp] theorem val_eq_zero {n : ℕ} (a : zmod n) : val a = 0 ↔ a = 0 := sorry

theorem val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : val ↑a = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val ↑a = a)) (val_cast_nat a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = a)) (nat.mod_eq_of_lt h))) (Eq.refl a))

theorem neg_val' {n : ℕ} [fact (0 < n)] (a : zmod n) : val (-a) = (n - val a) % n := sorry

theorem neg_val {n : ℕ} [fact (0 < n)] (a : zmod n) : val (-a) = ite (a = 0) 0 (n - val a) := sorry

/-- `val_min_abs x` returns the integer in the same equivalence class as `x` that is closest to `0`,
  The result will be in the interval `(-n/2, n/2]`. -/
def val_min_abs {n : ℕ} : zmod n → ℤ :=
  sorry

@[simp] theorem val_min_abs_def_zero (x : zmod 0) : val_min_abs x = x :=
  rfl

theorem val_min_abs_def_pos {n : ℕ} [fact (0 < n)] (x : zmod n) : val_min_abs x = ite (val x ≤ n / bit0 1) (↑(val x)) (↑(val x) - ↑n) :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] (x : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (x : zmod (Nat.succ n)) => Eq.refl (val_min_abs x)) _inst_1 x

@[simp] theorem coe_val_min_abs {n : ℕ} (x : zmod n) : ↑(val_min_abs x) = x := sorry

theorem nat_abs_val_min_abs_le {n : ℕ} [fact (0 < n)] (x : zmod n) : int.nat_abs (val_min_abs x) ≤ n / bit0 1 := sorry

@[simp] theorem val_min_abs_zero (n : ℕ) : val_min_abs 0 = 0 := sorry

@[simp] theorem val_min_abs_eq_zero {n : ℕ} (x : zmod n) : val_min_abs x = 0 ↔ x = 0 := sorry

theorem cast_nat_abs_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) : ↑(int.nat_abs (val_min_abs a)) = ite (val a ≤ n / bit0 1) a (-a) := sorry

@[simp] theorem nat_abs_val_min_abs_neg {n : ℕ} (a : zmod n) : int.nat_abs (val_min_abs (-a)) = int.nat_abs (val_min_abs a) := sorry

theorem val_eq_ite_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) : ↑(val a) = val_min_abs a + ite (val a ≤ n / bit0 1) 0 ↑n := sorry

theorem prime_ne_zero (p : ℕ) (q : ℕ) [hp : fact (nat.prime p)] [hq : fact (nat.prime q)] (hpq : p ≠ q) : ↑q ≠ 0 := sorry

end zmod

namespace zmod

/-- Field structure on `zmod p` if `p` is prime. -/
protected instance field (p : ℕ) [fact (nat.prime p)] : field (zmod p) :=
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul sorry
    comm_ring.one sorry sorry sorry sorry sorry has_inv.inv sorry (mul_inv_cancel_aux p) (inv_zero p)

end zmod

theorem ring_hom.ext_zmod {n : ℕ} {R : Type u_1} [semiring R] (f : zmod n →+* R) (g : zmod n →+* R) : f = g := sorry

namespace zmod

protected instance subsingleton_ring_hom {n : ℕ} {R : Type u_1} [semiring R] : subsingleton (zmod n →+* R) :=
  subsingleton.intro ring_hom.ext_zmod

protected instance subsingleton_ring_equiv {n : ℕ} {R : Type u_1} [semiring R] : subsingleton (zmod n ≃+* R) :=
  subsingleton.intro
    fun (f g : zmod n ≃+* R) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (f = g)) (propext (ring_equiv.coe_ring_hom_inj_iff f g)))) (ring_hom.ext_zmod ↑f ↑g)

theorem ring_hom_surjective {n : ℕ} {R : Type u_1} [ring R] (f : R →+* zmod n) : function.surjective ⇑f := sorry

theorem ring_hom_eq_of_ker_eq {n : ℕ} {R : Type u_1} [comm_ring R] (f : R →+* zmod n) (g : R →+* zmod n) (h : ring_hom.ker f = ring_hom.ker g) : f = g := sorry


import Lean

def f (x : Nat × Nat) :=
  match x with
  | .mk (snd := snd) .. => snd

example : f (10, 20) = 20 := rfl

open Lean
def g (e : Expr) : Expr :=
  match e with
  | .forallE (binderType := type) .. => type
  | e => e

def h (x : Nat × Nat) :=
  match x with
  | .mk (α := .(Nat)) (snd := snd) .. => snd


import analysis.special_functions.exp
import tactic

open real

variables a b c : ℝ

#check le_refl
#check sub_le_sub
#check exp_le_exp
#check exp_le_exp.mpr

-- BEGIN

example (h : a ≤ b) : c - exp b ≤ c - exp a :=
begin
  apply sub_le_sub,
    sorry,
  sorry,
end

-- END


import algebra.category.Module.basic
import linear_algebra.tensor_product
import linear_algebra.finsupp
import category_theory.adjunction.limits
import category_theory.limits.preserves.limits
-- import .hom

open_locale tensor_product

open tensor_product

universes u u' v

variables (R : Type u) (S : Type u') [comm_ring R] [comm_ring S]
variables (X : Type v) [add_comm_group X] [module R X] [module S X]

class bimodule :=
(smul_comm' [] : ∀ (r : R) (s : S) (x : X), r • s • x = s • r • x)

section bimodule

variables {R S X}

lemma bimodule.smul_comm [bimodule R S X] (r : R) (s : S) (x : X) :
  r • s • x = s • r • x :=
bimodule.smul_comm' r s x

instance bimodule.int (X' : Type v) [add_comm_group X'] [module R X'] :
  bimodule R ℤ X' :=
{ smul_comm' := λ r z x',
  begin
    induction z using int.induction_on with n hn n hn,
    { simp, },
    { simpa [add_smul, smul_add] using hn, },
    { simpa [sub_smul, smul_sub] using hn, },
  end }

instance bimodule.symm [bimodule R S X] : bimodule S R X :=
{ smul_comm' := λ s r x, (bimodule.smul_comm r s x).symm }

end bimodule

section tensor_bimodule

variable [bimodule R S X]
variables (Y : Type v) [add_comm_group Y] [module R Y]

@[simps]
def tensor_bimodule.smul_aux (s : S) : Y →ₗ[R] X →ₗ[R] Y ⊗[R] X :=
{ to_fun := λ y,
  { to_fun := λ x, y ⊗ₜ (s • x),
    map_add' := λ x x', by rw [smul_add, tmul_add],
    map_smul' := λ r x, by rw [ring_hom.id_apply, smul_tmul', smul_tmul,
      bimodule.smul_comm] },
  map_add' := λ y y', linear_map.ext $ λ x, by simp [linear_map.add_apply,
    add_tmul],
  map_smul' := λ r y, linear_map.ext $ λ x, by simp [smul_tmul, tmul_smul] }

@[simps]
def tensor_bimodule.smul (s : S) : (Y ⊗[R] X) →ₗ[R] (Y ⊗[R] X) :=
tensor_product.lift $ tensor_bimodule.smul_aux _ _ _ _ s

instance tensor_product.bimodule.has_smul : has_smul S (Y ⊗[R] X) :=
{ smul := λ s, tensor_bimodule.smul R S X Y s }

section

variables {R S X Y}

lemma tensor_bimodule.smul_def (s : S) (z : Y ⊗[R] X) :
  s • z = tensor_bimodule.smul _ _ _ _ s z := rfl

lemma tensor_bimodule.smul_tmul (s : S) (y : Y) (x : X) :
  s • (y ⊗ₜ x : _ ⊗[R] _) = y ⊗ₜ (s • x) := rfl

end

@[priority 100]
instance tensor_product.bimodule : module S (Y ⊗[R] X) :=
{ smul := (•),
  one_smul := λ z,
  begin
    induction z using tensor_product.induction_on with _ _ a b ha hb,
    { rw [tensor_bimodule.smul_def, map_zero], },
    { rw [tensor_bimodule.smul_tmul, one_smul], },
    { rw [tensor_bimodule.smul_def] at ha hb ⊢,
      rw [map_add, ha, hb], },
  end,
  mul_smul := λ s s' z,
  begin
    induction z using tensor_product.induction_on with y x a b ha hb,
    { simp only [tensor_bimodule.smul_def, map_zero], },
    { repeat { rw [tensor_bimodule.smul_tmul] },
      rw [mul_smul] },
    { repeat { rw [tensor_bimodule.smul_def] at ha hb ⊢ },
      rw [map_add, ha, hb, map_add, map_add], },
  end,
  smul_zero := λ s, by { rw [tensor_bimodule.smul_def, map_zero] },
  smul_add := λ _ _ _, by { simp only [tensor_bimodule.smul_def, map_add] },
  add_smul := λ s s' z,
  begin
    induction z using tensor_product.induction_on with y x a b ha hb,
    { simp only [tensor_bimodule.smul_def, map_zero, zero_add], },
    { repeat { rw [tensor_bimodule.smul_tmul] },
      rw [add_smul, tmul_add], },
    { repeat { rw [tensor_bimodule.smul_def] at ha hb ⊢, },
      simp only [map_add, ha, hb],
      abel, },
  end,
  zero_smul := λ z,
  begin
    induction z using tensor_product.induction_on with y x a b ha hb,
    { simp only [tensor_bimodule.smul_def, map_zero], },
    { repeat { rw [tensor_bimodule.smul_tmul] },
      rw [zero_smul, tmul_zero], },
    { repeat { rw [tensor_bimodule.smul_def] at ha hb ⊢, },
      simp only [map_add, ha, hb, add_zero], },
  end }

end tensor_bimodule

section bimodule_hom

variable [bimodule R S X]
variables (Z : Type v) [add_comm_group Z] [module S Z]

section

variables {R S X Z}

@[simps] def bimodule_hom.smul (r : R) (l : X →ₗ[S] Z) : X →ₗ[S] Z :=
{ to_fun := λ x, l (r • x),
  map_add' := λ _ _, by rw [smul_add, map_add],
  map_smul' := λ s x, by rw [bimodule.smul_comm, map_smul,
    ring_hom.id_apply] }

end

instance bimodule_hom.has_smul : has_smul R (X →ₗ[S] Z) :=
{ smul := bimodule_hom.smul }

lemma bimodule_hom.smul_def (r : R) (l : X →ₗ[S] Z) :
  r • l = bimodule_hom.smul r l := rfl

instance bimodule_hom : module R (X →ₗ[S] Z) :=
{ smul := (•),
  one_smul := λ l, linear_map.ext $ λ x,
    by simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, one_smul],
  mul_smul := λ r r' l, linear_map.ext $ λ x,
  begin
    simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, one_smul, mul_smul],
    rw smul_comm,
  end,
  smul_zero := λ r, linear_map.ext $ λ x,
    by simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, linear_map.zero_apply],
  smul_add := λ r l l', linear_map.ext $ λ x,
    by simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, linear_map.add_apply],
  add_smul := λ r r' l, linear_map.ext $ λ x,
    by simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, add_smul, map_add,
      linear_map.add_apply],
  zero_smul := λ l, linear_map.ext $ λ x,
  by simp only [bimodule_hom.smul_def, bimodule_hom.smul_apply, linear_map.zero_apply,
    zero_smul, map_zero], }

end bimodule_hom

namespace Module

@[simps]
def tensor_functor [bimodule R S X] : Module.{v} R ⥤ Module.{v} S :=
{ obj := λ Y, Module.of S (Y ⊗[R] X),
  map := λ Y Y' l,
  { to_fun := tensor_product.map l linear_map.id,
    map_add' := λ z z', by rw [map_add],
    map_smul' := λ s (z : Y ⊗[R] X),
    begin
      induction z using tensor_product.induction_on with y x a b ha hb,
      { rw [smul_zero, map_zero, smul_zero], },
      { rw [tensor_bimodule.smul_tmul, map_tmul, linear_map.id_apply, map_tmul, ring_hom.id_apply,
          linear_map.id_apply, tensor_bimodule.smul_tmul], },
      { rw [smul_add, map_add, ha, hb, map_add, smul_add], },
    end },
  map_id' := λ Y, linear_map.ext $ λ z,
  begin
    simp only [linear_map.coe_mk, id_apply],
    erw [map_id, linear_map.id_apply],
  end,
  map_comp' := λ Y Y' Y'' l l', linear_map.ext $ λ z,
  begin
    simp only [linear_map.coe_mk, coe_comp, function.comp_app],
    induction z using tensor_product.induction_on with _ _ a b ha hb,
    { simp only [map_zero], },
    { simp only [tensor_product.map_tmul, linear_map.id_apply, category_theory.comp_apply] },
    { rw [map_add, ha, hb, map_add, map_add], }
  end }

@[simps]
def hom_functor [bimodule R S X] : Module.{v} S ⥤ Module R :=
{ obj := λ Z, Module.of R $ X →ₗ[S] Z,
  map := λ Z Z' (l : Z →ₗ[S] Z'),
  { to_fun := l.comp,
    map_add' := λ z z', by rw linear_map.comp_add,
    map_smul' := λ r f, linear_map.ext $ λ x, rfl },
  map_id' := λ Z,
    by { ext l x, simp only [linear_map.coe_mk, linear_map.comp_apply, id_apply] },
  map_comp' := λ Z Z' Z'' (l : Z →ₗ[S] Z') (l' : Z' →ₗ[S] Z''),
    linear_map.ext $ λ (l'' : X →ₗ[S] Z), linear_map.ext $ λ x, by simp, }

end Module

namespace Module

variables (R' : Type u) (S' : Type u') [comm_ring R'] [comm_ring S']
variables (X' : Type v) [add_comm_group X'] [module R' X'] [module S' X'] [bimodule R' S' X']

namespace tensor_hom_adjunction

@[simps]
def hom_equiv.to_fun' {Y : Module.{v} R'} {Z : Module.{v} S'} (l : Y ⊗[R'] X' →ₗ[S'] Z) :
  (Y ⟶ (hom_functor R' S' X').obj Z) :=
{ to_fun := λ y,
  { to_fun := λ x, l (y ⊗ₜ x),
    map_add' := λ x x', by rw [tmul_add, map_add],
    map_smul' := λ s x, by rw [ring_hom.id_apply, ←map_smul, tensor_bimodule.smul_tmul] },
  map_add' := λ y y', linear_map.ext $ λ x, by simp [add_tmul, map_add],
  map_smul' := λ r y, linear_map.ext $ λ x,by simp [bimodule_hom.smul_def,
    bimodule_hom.smul_apply, smul_tmul], }

@[simps]
def hom_equiv.inv_fun' {Y : Module.{v} R'} {Z : Module.{v} S'} (l : Y →ₗ[R'] (X' →ₗ[S'] Z)) :
  ((tensor_functor R' S' X').obj Y ⟶ Z) :=
{ to_fun := (add_con_gen _).lift (free_add_monoid.lift $ show Y × X' → Z, from λ p, l p.1 p.2) $
    add_con.add_con_gen_le $ λ p p' (h : eqv R' Y X' p p'),
      show (free_add_monoid.lift $ show Y × X' → Z, from λ p, l p.1 p.2) p
        = (free_add_monoid.lift $ show Y × X' → Z, from λ p, l p.1 p.2) p',
      from match p, p', h with
      | _, _, (eqv.of_zero_left n) := by simp only [free_add_monoid.lift_eval_of, map_zero,
        linear_map.zero_apply]
      | _, _, (eqv.of_zero_right m) := by simp only [free_add_monoid.lift_eval_of, map_zero]
      | _, _, (eqv.of_add_left m₁ m₂ n)  := by simp only [map_add, free_add_monoid.lift_eval_of,
        linear_map.add_apply]
      | _, _, (eqv.of_add_right m n₁ n₂) := by simp only [map_add, free_add_monoid.lift_eval_of]
      | _, _, (eqv.of_smul r m n) := by simp only [free_add_monoid.lift_eval_of, map_smul,
        bimodule_hom.smul_def, bimodule_hom.smul_apply]
      | _, _, (eqv.add_comm x y) := by simpa only [map_add, free_add_monoid.lift_eval_of]
        using add_comm _ _
      end,
  map_add' := λ _ _, by rw map_add,
  map_smul' := λ s (z : Y ⊗[R'] X'),
  begin
    induction z using tensor_product.induction_on with y x a b ha hb,
    { rw [smul_zero, map_zero, smul_zero], },
    { rw [tensor_bimodule.smul_tmul, tmul, add_con.coe_mk', add_con.lift_coe,
        free_add_monoid.lift_eval_of, ring_hom.id_apply, tmul, add_con.coe_mk', add_con.lift_coe,
        free_add_monoid.lift_eval_of],
      simp only [map_smul], },
    { rw [smul_add, map_add, ha, hb, map_add, smul_add], }
  end }

@[simps]
def hom_equiv (Y : Module.{v} R') (Z : Module.{v} S') :
  ((tensor_functor R' S' X').obj Y ⟶ Z) ≃ (Y ⟶ (hom_functor R' S' X').obj Z) :=
{ to_fun := hom_equiv.to_fun' R' S' X',
  inv_fun := hom_equiv.inv_fun' R' S' X',
  left_inv := λ l, linear_map.ext $ λ (p : Y ⊗[R'] X'),
  begin
    simp only [hom_equiv.to_fun'_apply_apply, hom_equiv.inv_fun'_apply],
    induction p using tensor_product.induction_on with y x a b ha hb,
    { rw [map_zero, map_zero], },
    { conv_lhs { rw [tmul, add_con.coe_mk', add_con.lift_coe, free_add_monoid.lift_eval_of] }, },
    { conv_lhs { rw [map_add, ha, hb, ←map_add], } }
  end,
  right_inv := λ (l : Y →ₗ[R'] (X'→ₗ[S'] Z)), linear_map.ext $ λ y, linear_map.ext $ λ x,
  begin
    simp only [hom_equiv.to_fun'_apply_apply, hom_equiv.inv_fun'_apply],
    conv_lhs { rw [tmul, add_con.coe_mk', add_con.lift_coe, free_add_monoid.lift_eval_of] },
  end }

@[simps]
def unit : 𝟭 (Module R') ⟶ tensor_functor R' S' X' ⋙ hom_functor R' S' X' :=
{ app := λ Y, show Y →ₗ[R'] (X' →ₗ[S'] (Y ⊗[R'] X')), from
  { to_fun := λ y,
    { to_fun := λ x, y ⊗ₜ x,
      map_add' := λ x x', by rw tmul_add,
      map_smul' := λ s x, by rw [ring_hom.id_apply]; refl },
    map_add' := λ y y', linear_map.ext $ λ x, by simp only [linear_map.coe_mk, add_tmul,
      linear_map.add_apply],
    map_smul' := λ r y, linear_map.ext $ λ x, by simp only [linear_map.coe_mk, linear_map.smul_apply,
      bimodule_hom.smul_def, bimodule_hom.smul_apply, ring_hom.id_apply, smul_tmul], },
  naturality' := λ Y Y' (l : Y →ₗ[R'] Y'), linear_map.ext $ λ (y : Y), linear_map.ext $ λ x,
  begin
    simp only [category_theory.comp_apply, linear_map.coe_mk, category_theory.functor.id_map,
      category_theory.functor.comp_map, hom_functor_map_apply, linear_map.comp_apply,
      tensor_functor_map_apply, map_tmul, linear_map.id_coe, id.def],
  end }

@[simps] def counit : hom_functor R' S' X' ⋙ tensor_functor R' S' X' ⟶ 𝟭 (Module S') :=
{ app := λ Z, show ((X' →ₗ[S'] Z) ⊗[R'] X') →ₗ[S'] Z, from
  { to_fun := (add_con_gen _).lift (free_add_monoid.lift $ λ (p : (X' →ₗ[S'] ↥Z) × X'), p.1 p.2) $
    add_con.add_con_gen_le $ λ p p' (h : eqv R' (X' →ₗ[S'] Z) X' p p'),
      show (free_add_monoid.lift $ λ (p : (X' →ₗ[S'] ↥Z) × X'), p.1 p.2) p =
      (free_add_monoid.lift $ λ (p : (X' →ₗ[S'] ↥Z) × X'), p.1 p.2) p',
      from match p, p', h with
      | _, _, (eqv.of_zero_left n) := by simp only [free_add_monoid.lift_eval_of, map_zero,
        linear_map.zero_apply]
      | _, _, (eqv.of_zero_right m) := by simp only [free_add_monoid.lift_eval_of, map_zero]
      | _, _, (eqv.of_add_left m₁ m₂ n)  := by simp only [map_add, free_add_monoid.lift_eval_of,
        linear_map.add_apply]
      | _, _, (eqv.of_add_right m n₁ n₂) := by simp only [map_add, free_add_monoid.lift_eval_of]
      | _, _, (eqv.of_smul r m n) := by simp only [free_add_monoid.lift_eval_of, map_smul,
        bimodule_hom.smul_def, bimodule_hom.smul_apply]
      | _, _, (eqv.add_comm x y) := by simpa only [map_add, free_add_monoid.lift_eval_of]
        using add_comm _ _
      end,
    map_add' := λ p p', by rw map_add,
    map_smul' :=
    begin
      rintros s p,
      induction p using tensor_product.induction_on with l x a b ha hb,
      { simp only [map_zero, smul_zero], },
      { rw [tensor_bimodule.smul_tmul, tmul, add_con.coe_mk', add_con.lift_coe,
          free_add_monoid.lift_eval_of, ring_hom.id_apply, tmul, add_con.coe_mk', add_con.lift_coe,
          free_add_monoid.lift_eval_of, linear_map.map_smul], },
      { rw [smul_add, map_add, ha, hb, map_add, smul_add] }
    end },
  naturality' := λ Z Z' (l : Z →ₗ[S'] Z'), linear_map.ext $ λ (p : (X' →ₗ[S'] Z) ⊗[R'] X'),
  begin
    induction p using tensor_product.induction_on with l' x a b ha hb,
    { simp only [map_zero] },
    { simp only [category_theory.comp_apply, linear_map.coe_mk, category_theory.functor.comp_map,
        hom_functor_map_apply, tensor_functor_map_apply, tensor_product.map_tmul,
        category_theory.functor.id_map, linear_map.id_apply],
      simp only [tmul, add_con.coe_mk', add_con.lift_coe, free_add_monoid.lift_eval_of,
        linear_map.comp_apply], },
    { rw [map_add, ha, hb, map_add], },
  end }

lemma hom_equiv_unit (Y : Module.{v} R') (Z : Module.{v} S') (f) :
  hom_equiv R' S' X' Y Z f =
  (unit R' S' X').app Y ≫ (hom_functor R' S' X').map f :=
linear_map.ext $ λ y, linear_map.ext $ λ x, rfl

lemma hom_equiv_counit (Y : Module.{v} R') (Z : Module.{v} S') (g) :
  (hom_equiv R' S' X' Y Z).symm g =
  (tensor_functor _ _ _).map g ≫ (counit R' S' X').app Z :=
linear_map.ext $ λ z,
begin
  induction z using tensor_product.induction_on with y x a b ha hb,
  { simp only [map_zero] },
  { conv_lhs { rw [hom_equiv_symm_apply, hom_equiv.inv_fun'_apply, tmul, add_con.coe_mk',
      add_con.lift_coe, free_add_monoid.lift_eval_of] },
    conv_rhs { rw [category_theory.comp_apply, tensor_functor_map_apply, tensor_product.map_tmul,
      linear_map.id_apply, counit_app_apply, tmul, add_con.coe_mk', add_con.lift_coe,
      free_add_monoid.lift_eval_of] }, },
  { rw [map_add, ha, hb, map_add] },
end

end tensor_hom_adjunction

@[simps]
def tensor_hom_adjunction : (tensor_functor R' S' X') ⊣ (hom_functor R' S' X') :=
{ hom_equiv := tensor_hom_adjunction.hom_equiv _ _ _,
  unit := tensor_hom_adjunction.unit _ _ _,
  counit := tensor_hom_adjunction.counit _ _ _,
  hom_equiv_unit' := tensor_hom_adjunction.hom_equiv_unit _ _ _,
  hom_equiv_counit' := tensor_hom_adjunction.hom_equiv_counit _ _ _ }

section

instance : category_theory.is_left_adjoint (tensor_functor R' S' X') :=
⟨_, tensor_hom_adjunction _ _ _⟩

instance : category_theory.is_right_adjoint (hom_functor R' S' X') :=
⟨_, tensor_hom_adjunction _ _ _⟩

instance : category_theory.limits.preserves_colimits (tensor_functor R' S' X') :=
category_theory.adjunction.left_adjoint_preserves_colimits (tensor_hom_adjunction R' S' X')

instance : category_theory.limits.preserves_limits (hom_functor R' S' X') :=
category_theory.adjunction.right_adjoint_preserves_limits (tensor_hom_adjunction R' S' X')

instance : category_theory.functor.preserves_epimorphisms (tensor_functor R' S' X') :=
infer_instance

end

end Module

namespace tensor_product

variables (R' : Type u) [comm_ring R']
variables {M N : Type v} [add_comm_group M] [add_comm_group N]
variables [module R' M] [module R' N]

@[simps]
def to_add_comm_group {C : Type v} [add_comm_group C]
  (b : M →+ (N →+ C)) (hb : ∀ (r : R') (m : M) (n : N), b (r • m) n = b m (r • n)) :
  (M ⊗[R'] N) →+ C :=
(((@Module.tensor_hom_adjunction R' ℤ _ _ N _ _ _ (bimodule.int _)).hom_equiv
  (Module.of R' M) (Module.of _ C)).symm
{ to_fun := λ (m : M), add_monoid_hom.to_int_linear_map $ b m,
  map_add' := λ (m m' : M), by rw [map_add]; refl,
  map_smul' := λ r (m : M), linear_map.ext $ λ n,
  by simpa only [add_monoid_hom.coe_to_int_linear_map, ring_hom.id_apply, hb] }).to_add_monoid_hom

lemma to_add_comm_group.apply_tmul {C : Type v} [add_comm_group C]
  (b : M →+ (N →+ C)) (hb : ∀ (r : R') (m : M) (n : N), b (r • m) n = b m (r • n))
  (m : M) (n : N) : to_add_comm_group R' b hb (m ⊗ₜ n) = b m n :=
by rw [to_add_comm_group_apply, tmul, add_con.coe_mk', add_con.lift_coe,
    free_add_monoid.lift_eval_of]

lemma to_add_comm_group.uniq {C : Type v} [add_comm_group C]
  (b : M →+ (N →+ C)) (hb : ∀ (r : R') (m : M) (n : N), b (r • m) n = b m (r • n))
  (l : (M ⊗[R'] N) →+ C) (hl : ∀ ⦃m : M⦄ ⦃n : N⦄,  l (m ⊗ₜ n) = b m n) :
  to_add_comm_group R' b hb = l := add_monoid_hom.ext $ λ z,
begin
  induction z using tensor_product.induction_on with m n x y hx hy,
  { simp only [map_zero] },
  { rw [to_add_comm_group.apply_tmul, hl], },
  { rw [map_add, hx, hy, map_add] },
end

@[reducible]
def to_add_comm_group' {C : Type v} [add_comm_group C]
  (b : M × N → C)
  (hN0 : ∀ (n : N), b (0, n) = 0)
  (hM0 : ∀ (m : M), b (m, 0) = 0)
  (hMadd : ∀ (n : N) (m m' : M), b (m + m', n) = b (m, n) + b (m', n))
  (hNadd : ∀ (m : M) (n n' : N), b (m, n + n') = b (m, n) + b (m, n'))
  (hb : ∀ (r : R') (m : M) (n : N), b ((r • m), n) = b (m, (r • n))) :
  (M ⊗[R'] N) →+ C :=
to_add_comm_group R'
{ to_fun := λ m,
  { to_fun := λ n, b (m, n),
    map_zero' := hM0 _,
    map_add' := hNadd _ },
  map_zero' := add_monoid_hom.ext $ λ n, show b (0, n) = 0, from hN0 _,
  map_add' := λ m m', add_monoid_hom.ext $ λ n, show b (m + m', n) = b (m, n) + b (m', n),
    from hMadd _ _ _ } $ λ r m n,
show b (r • m, n) = b (m, r • n), from hb _ _ _

lemma to_add_comm_group'.apply_tmul {C : Type v} [add_comm_group C]
  (b : M × N → C)
  (hN0 : ∀ (n : N), b (0, n) = 0)
  (hM0 : ∀ (m : M), b (m, 0) = 0)
  (hMadd : ∀ (n : N) (m m' : M), b (m + m', n) = b (m, n) + b (m', n))
  (hNadd : ∀ (m : M) (n n' : N), b (m, n + n') = b (m, n) + b (m, n'))
  (hb : ∀ (r : R') (m : M) (n : N), b ((r • m), n) = b (m, (r • n)))
  (m : M) (n : N) : to_add_comm_group' R' b hN0 hM0 hMadd hNadd hb (m ⊗ₜ n) = b (m, n) :=
by rw [to_add_comm_group.apply_tmul]; refl

open_locale big_operators

lemma exists_rep (z : M ⊗[R'] N) :
  ∃ {ι : Type v} (ms : ι → M) (ns : ι → N) (s : finset ι),
  z = ∑ i in s, ms i ⊗ₜ ns i :=
begin
  classical,
  have EQ := span_tmul_eq_top R' M N,
  have mem1 : z ∈ ⊤ := submodule.mem_top,
  rw ←EQ at mem1,
  rw mem_span_set at mem1,
  obtain ⟨c, hc1, rfl⟩ := mem1,
  choose m n hm using hc1,
  refine ⟨M ⊗[R'] N, λ i, if hi : i ∈ c.support then c i • m hi else 0,
    λ i, if hi : i ∈ c.support then n hi else 0, c.support, _⟩,
  rw finsupp.sum,
  refine finset.sum_congr rfl (λ i hi, _),
  split_ifs,
  { specialize hm h,
    rw ←smul_tmul',
    congr' 1,
    exact hm.symm, },
  exact false.elim (h hi),
end

end tensor_product


import ECTate.Algebra.Field.Basic
import ECTate.Algebra.Ring.Basic
import ECTate.Algebra.ValuedRing
import ECTate.Data.Nat.Enat
import Mathlib.Tactic.GeneralizeProofs
import Mathlib.Init.Data.Nat.Lemmas

open Classical
variable (R : Type _) [Semiring R]

/-- Noncomputable function that outputs the unique characteristic of a semiring. -/
noncomputable
def ring_char := if h : _ then @Nat.find (fun n => n ≠ 0 ∧ (n : R) = 0) _ h else 0

lemma ring_char_eq_zero (R : Type _) [Semiring R] :
  (ring_char R : R) = 0 :=
by
  rw [ring_char]
  split
  . exact (And.right (Nat.find_spec (by assumption)))
  . simp

lemma ring_char_dvd_of_zero {R : Type _} [Ring R] (h : (m : R) = 0) :
  ring_char R ∣ m :=
by
  by_cases hm : m = 0
  . simp [hm, Nat.dvd_zero] at *
  . rw [ring_char]
    rw [dif_pos ?_]

    rotate_right 1 -- swap -- TODO unknown swap
    exists m
    generalize_proofs hh
    have good := Nat.find_spec hh
    have bd : Nat.find _ ≤ Nat.gcd (Nat.find hh) m := Nat.find_min' hh ?_
    rw [Nat.gcd_eq_left_iff_dvd]
    simp at good
    simp at bd
    sorry
    sorry

lemma ring_char_is_zero_or_prime (R : Type _) [CommRing R] [IsDomain R] :
  ring_char R = 0 ∨ Nat.Prime (ring_char R) := sorry

lemma add_pow_ring_char {R : Type _} [CommRing R] [IsDomain R] (h : ring_char R ≠ 0) :
  (a + b) ^ ring_char R =
  a ^ ring_char R +
  b ^ ring_char R := by sorry

lemma sub_pow_ring_char {R : Type _} (a b : R) [CommRing R] [IsDomain R] (h : ring_char R ≠ 0) :
  (a - b) ^ ring_char R =
  a ^ ring_char R -
  b ^ ring_char R := by sorry

lemma pow_ring_char_injective {R : Type _} [CommRing R] [IsDomain R]
  (hn : ring_char R ≠ 0) : Function.Injective (. ^ ring_char R : R → R) := by
  intros x y h
  rw [←sub_eq_zero] at *
  rw [←sub_eq_zero] at *
  simp only [sub_zero] at *
  rw [← sub_pow_ring_char _ _ hn] at h
  exact pow_eq_zero h


import algebraic_topology.nerve
import algebraic_topology.topological_simplex
import category_theory.adjunction.basic
import category_theory.adjunction.comma
import category_theory.limits.presheaf

open category_theory opposite

def my_nerve : (Cat ⥤ sSet) :=
  colimit_adj.restricted_yoneda simplex_category.to_Cat

lemma i_hate_yoneda (X : Cat) (Y : Catᵒᵖ) :
      (yoneda.obj X).obj Y = (Y.unop ⟶ X) := by simp

lemma i_hate_op (X : simplex_categoryᵒᵖ) (F : simplex_category ⥤ Cat) :
      unop (F.op.obj X) = F.obj X.unop := by simp

lemma helper_ext (X : Cat) (Y : simplex_categoryᵒᵖ) :
(yoneda.obj X).obj (simplex_category.to_Cat.op.obj Y) = (nerve X).obj Y := begin
  have : (nerve X).obj Y = ((simplex_category.to_Cat.obj Y.unop) ⥤ X), simp,
  rw this,
  rw i_hate_yoneda,
  rw i_hate_op Y simplex_category.to_Cat,
  refl,
end

noncomputable lemma helper (X : Cat) :
simplex_category.to_Cat.op ⋙ yoneda.obj X ≅ nerve X :=
by refine {
  hom := { app := begin
    intro Y, rw functor.comp_obj,
    rw helper_ext,
    exact 𝟙 _,
  end },
  inv := { app := begin
    intro Y, rw functor.comp_obj,
    rw helper_ext,
    exact 𝟙 _,
  end },
}

#check my_nerve.map

noncomputable lemma nerve_is_a_nerve : my_nerve ≅ nerve_functor := {
  hom := {
    app := λ Y, begin
      unfold my_nerve, unfold colimit_adj.restricted_yoneda, simp,
      apply (helper Y).hom,
    end,
    naturality' := begin
      intros, simp,

    end

  },
  inv := {
    app := λ Y, begin
      unfold my_nerve, unfold colimit_adj.restricted_yoneda, simp,
      apply (helper Y).inv,
    end,
    naturality' := sorry
  },
}


import data.set.basic -- hide
open set -- hide

/- Tactic : exfalso

## Summary

Changes the goal to `⊢ false`.

## Details

This may seem hard to prove,
but it is useful when we have a contradiction in the hypotheses.

For example, if we have `h : ¬ P` as a hypothesis and we apply `exfalso`
we can then `apply h` to transform the goal into `⊢ P`.
-/

/- Hint : Click here for a hint, in case you get stuck.
In Lean, the  negation `¬ P` of a statement is a shorthand for `P → false`. Therefore
start with `exfalso`, and remember that negation is the same as `→ false`.
-/

variables {X Y : Type} -- hide

/- Lemma : no-side-bar
We can prove that 1 equals 0 if we have a contradiction in our hypotheses.
-/
lemma one_eq_zero_of_contradiction (A : set X) (x : X) (h1 : x ∈ A) (h2 : x ∉ A): 1 = 0 :=
begin
  exfalso,
  apply h2,
  exact h1,

end


import cicm2022.examples.Proj.degree_zero_part
import cicm2022.examples.Proj.structure_sheaf
import cicm2022.examples.Proj.lemmas
import cicm2022.examples.Proj.Proj_iso_Spec.Top_component.from_Spec

import algebraic_geometry.structure_sheaf
import algebraic_geometry.Spec

noncomputable theory

namespace algebraic_geometry

open_locale direct_sum big_operators pointwise big_operators
open direct_sum set_like.graded_monoid localization finset (hiding mk_zero)

variables {R A : Type*}
variables [comm_ring R] [comm_ring A] [algebra R A]

variables (𝒜 : ℕ → submodule R A)
variables [graded_algebra 𝒜]

open Top topological_space
open category_theory opposite
open projective_spectrum.structure_sheaf

local notation `Proj` := Proj.to_LocallyRingedSpace 𝒜
-- `Proj` as a locally ringed space
local notation `Proj.T` := Proj .1.1.1
-- the underlying topological space of `Proj`
local notation `Proj| ` U := Proj .restrict (opens.open_embedding (U : opens Proj.T))
-- `Proj` restrict to some open set
local notation `Proj.T| ` U :=
  (Proj .restrict (opens.open_embedding (U : opens Proj.T))).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Proj` restricted to some open set
local notation `pbo` x := projective_spectrum.basic_open 𝒜 x
-- basic open sets in `Proj`
local notation `sbo` f := prime_spectrum.basic_open f
-- basic open sets in `Spec`
local notation `Spec` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring)
-- `Spec` as a locally ringed space
local notation `Spec.T` ring :=
  (Spec.LocallyRingedSpace_obj (CommRing.of ring)).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Spec`
local notation `A⁰_` f_deg := degree_zero_part f_deg

namespace Proj_iso_Spec_Sheaf_component

namespace from_Spec

open algebraic_geometry

variables {𝒜} {m : ℕ} {f : A} (hm : 0 < m) (f_deg : f ∈ 𝒜 m) (V : (opens (Spec (A⁰_ f_deg)))ᵒᵖ)
variables (hh : (Spec (A⁰_ f_deg)).presheaf.obj V)
variables (y : ((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
  ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj V)).unop)

lemma data_prop1 : y.1 ∈ (pbo f) :=
begin
  obtain ⟨⟨a, ha1⟩, -, ha2⟩ := y.2,
  rw ← ha2,
  exact ha1,
end

lemma data_prop2 :
  (Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, data_prop1 hm f_deg V y⟩ ∈ unop V :=
begin
  obtain ⟨⟨a, ha1⟩, ha2, ha3⟩ := y.2,
  erw set.mem_preimage at ha2,
  convert ha2,
  rw ← ha3,
  refl,
end

variable {V}
def data : structure_sheaf.localizations (A⁰_ f_deg)
  ((Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, data_prop1 _ _ _ _⟩) :=
hh.1 ⟨_, data_prop2 _ _ _ _⟩

lemma data.one :
  data hm f_deg (1 : (Spec (A⁰_ f_deg)).presheaf.obj V) = 1 := rfl

lemma data.zero :
  data hm f_deg (0 : (Spec (A⁰_ f_deg)).presheaf.obj V) = 0 := rfl

lemma data.add_apply (x y : (Spec (A⁰_ f_deg)).presheaf.obj V) (z):
  data hm f_deg (x + y) z = data hm f_deg x z + data hm f_deg y z := rfl

lemma data.mul_apply (x y : (Spec (A⁰_ f_deg)).presheaf.obj V) (z):
  data hm f_deg (x * y) z = data hm f_deg x z * data hm f_deg y z := rfl

private lemma data.exist_rep
  (data : structure_sheaf.localizations (A⁰_ f_deg) ((Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, data_prop1 _ _ _ _⟩)) :
  ∃ (a : A⁰_ f_deg) (b : ((Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, data_prop1 _ _ _ _⟩).as_ideal.prime_compl),
  data = mk a b :=
begin
  induction data using localization.induction_on with d,
  rcases d with ⟨a, b⟩,
  refine ⟨a, b, rfl⟩,
end

def data.num : A⁰_ f_deg :=
classical.some $ data.exist_rep hm f_deg y (data hm f_deg hh y)

def data.denom : A⁰_ f_deg :=
(classical.some $ classical.some_spec $ data.exist_rep hm f_deg y (data hm f_deg hh y)).1

lemma data.denom_not_mem :
  (data.denom hm f_deg hh y) ∉ ((Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, data_prop1 _ _ _ _⟩).as_ideal :=
(classical.some $ classical.some_spec $ data.exist_rep hm f_deg y (data hm f_deg hh y)).2

lemma data.eq_num_div_denom :
  (data hm f_deg hh y) =
  localization.mk (data.num hm f_deg hh y) ⟨data.denom hm f_deg hh y, data.denom_not_mem hm f_deg hh y⟩ :=
begin
  rw classical.some_spec (classical.some_spec (data.exist_rep hm f_deg y (data hm f_deg hh y))),
  congr,
  rw subtype.ext_iff,
  refl,
end

def num : A :=
degree_zero_part.num (data.num hm f_deg hh y) * f^(degree_zero_part.deg (data.denom hm f_deg hh y))

lemma num.mem :
  (num hm f_deg hh y) ∈
    𝒜 (m * (degree_zero_part.deg (data.num hm f_deg hh y))
      + m * (degree_zero_part.deg (data.denom hm f_deg hh y))) :=
mul_mem (degree_zero_part.num_mem _) $ begin
  convert (set_like.graded_monoid.pow_mem (degree_zero_part.deg (data.denom hm f_deg hh y)) f_deg) using 1,
  rw mul_comm,
  refl,
end

def denom : A :=
degree_zero_part.num (data.denom hm f_deg hh y) * f^(degree_zero_part.deg (data.num hm f_deg hh y))

lemma denom.mem :
  (denom hm f_deg hh y) ∈
  𝒜 (m * (degree_zero_part.deg (data.num hm f_deg hh y))
      + m * (degree_zero_part.deg (data.denom hm f_deg hh y))) :=
begin
  change _ * _ ∈ _,
  rw mul_comm,
  apply set_like.graded_monoid.mul_mem,
  { rw mul_comm,
    exact set_like.graded_monoid.pow_mem (degree_zero_part.deg (data.num hm f_deg hh y)) f_deg, },
  { apply degree_zero_part.num_mem, },
end

lemma denom_not_mem :
  denom hm f_deg hh y ∉ y.1.as_homogeneous_ideal := λ rid,
begin
  rcases y.1.is_prime.mem_or_mem rid with H1 | H2,
  { have mem1 := data.denom_not_mem hm f_deg hh y,
    have eq1 := degree_zero_part.eq (data.denom hm f_deg hh y),
    dsimp only at mem1,
    change _ ∉ _ at mem1,
    apply mem1,
    change
      (data.denom hm f_deg hh y) ∈ ((Proj_iso_Spec_Top_component.to_Spec.carrier f_deg) ⟨y.1, _⟩),
    rw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff,
    rw eq1,
    convert ideal.mul_mem_left _ _ _,
    work_on_goal 2
    { exact mk 1 ⟨f^degree_zero_part.deg (data.denom hm f_deg hh y), ⟨_, rfl⟩⟩ },
    work_on_goal 2
    { exact mk (degree_zero_part.num (data.denom hm f_deg hh y)) 1 },
    { rw [mk_mul, one_mul, mul_one], },
    { apply ideal.subset_span,
      exact ⟨_, H1, rfl⟩ }, },
  { replace H2 := y.1.is_prime.mem_of_pow_mem _ H2,
    obtain ⟨⟨a, ha1⟩, ha2, ha3⟩ := y.2,
    erw projective_spectrum.mem_basic_open at ha1,
    apply ha1,
    convert H2, }
end

variable (V)
def bmk : homogeneous_localization 𝒜 y.1.as_homogeneous_ideal.to_ideal := quotient.mk'
{ deg := m * (degree_zero_part.deg (data.num hm f_deg hh y))
      + m * (degree_zero_part.deg (data.denom hm f_deg hh y)),
  num := ⟨num hm f_deg hh y, num.mem hm f_deg hh y⟩,
  denom := ⟨denom hm f_deg hh y, denom.mem hm f_deg hh y⟩,
  denom_not_mem := denom_not_mem hm f_deg hh y }

lemma bmk_one :
  bmk hm f_deg V 1 = 1 :=
begin
  ext1 y,
  have y_mem : y.val ∈ (pbo f).val,
  { erw projective_spectrum.mem_basic_open,
    intro rid,
    have mem1 := y.2,
    erw set.mem_preimage at mem1,
    obtain ⟨⟨a, ha1⟩, ha, ha2⟩ := mem1,
    change a = y.1 at ha2,
    erw set.mem_preimage at ha,
    erw ←ha2 at rid,
    apply ha1,
    exact rid },

  rw pi.one_apply,
  unfold bmk,
  rw [homogeneous_localization.ext_iff_val, homogeneous_localization.val_mk', homogeneous_localization.one_val],
  simp only [← subtype.val_eq_coe],
  unfold num denom,

  have eq1 := data.eq_num_div_denom hm f_deg 1 y,
  rw [data.one, pi.one_apply] at eq1,
  replace eq1 := eq1.symm,
  rw [show (1 : structure_sheaf.localizations (A⁰_ f_deg)
    (((Proj_iso_Spec_Top_component hm f_deg).hom) ⟨y.val, y_mem⟩)) = localization.mk 1 1,
    by erw localization.mk_self 1, localization.mk_eq_mk'] at eq1,
  replace eq1 := (@@is_localization.eq _ _ _ _).mp eq1,
  obtain ⟨⟨⟨C, C_degree_zero⟩, hC⟩, eq1⟩ := eq1,
  induction C using localization.induction_on with 𝔻,
  obtain ⟨C, ⟨_, ⟨l, rfl⟩⟩⟩ := 𝔻,
  simp only [mul_one, one_mul, subtype.coe_mk] at eq1,
  simp only [localization.mk_eq_mk', is_localization.eq],
  change _ ∉ _ at hC,
  erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff at hC,
  rw subtype.coe_mk at hC,
  dsimp only at C_degree_zero hC,

  have eq_num := degree_zero_part.eq (data.num hm f_deg 1 y),
  have eq_denom := degree_zero_part.eq (data.denom hm f_deg 1 y),

  simp only [subtype.val_eq_coe, submonoid.coe_one, mul_one] at eq1,
  rw subtype.ext_iff at eq1,
  simp only [subring.coe_mul] at eq1,
  erw [eq_num, eq_denom, localization.mk_mul, localization.mk_mul] at eq1,
  simp only [localization.mk_eq_mk', is_localization.eq, subtype.coe_mk] at eq1,
  obtain ⟨⟨_, ⟨n1, rfl⟩⟩, eq1⟩ := eq1,
  simp only [submonoid.coe_mul, subtype.coe_mk] at eq1,

  have C_not_mem : C ∉ y.1.as_homogeneous_ideal,
  { intro rid,
    have eq1 : (localization.mk C ⟨f ^ l, ⟨_, rfl⟩⟩ : localization.away f) =
      (localization.mk 1 ⟨f^l, ⟨_, rfl⟩⟩ : localization.away f) * localization.mk C 1,
      rw [localization.mk_mul, one_mul, mul_one],
    erw eq1 at hC,
    apply hC,
    convert ideal.mul_mem_left _ _ _,
    apply ideal.subset_span,
    refine ⟨_, rid, rfl⟩, },

  rw [show (1 : localization.at_prime y.1.as_homogeneous_ideal.to_ideal) = mk (1 : _) 1, by erw mk_self 1, mk_eq_mk', is_localization.eq],
  use C * (f^l * f^n1),
  { intros rid,
    rcases y.1.is_prime.mem_or_mem rid with H1 | H3,
    exact C_not_mem H1,
    rw ←pow_add at H3,
    replace H3 := y.1.is_prime.mem_of_pow_mem _ H3,
    apply y_mem,
    exact H3, },

  simp only [submonoid.coe_one, one_mul, mul_one],
  simp only [subtype.coe_mk],

  rw calc degree_zero_part.num (data.num hm f_deg 1 y)
        * f ^ degree_zero_part.deg (data.denom hm f_deg 1 y)
        * (C * (f ^ l * f ^ n1))
      = degree_zero_part.num (data.num hm f_deg 1 y) * C
        * f ^ (degree_zero_part.deg (data.denom hm f_deg 1 y) + l)
        * f^n1 : by ring_exp,
  rw [pow_add, eq1],
  ring,
end

lemma bmk_zero :
  bmk hm f_deg V 0 = 0 :=
begin
  ext1 y,
  have y_mem : y.val ∈ (pbo f).val,
  { erw projective_spectrum.mem_basic_open,
    intro rid,
    have mem1 := y.2,
    erw set.mem_preimage at mem1,
    obtain ⟨⟨a, ha1⟩, ha, ha2⟩ := mem1,
    change a = y.1 at ha2,
    erw set.mem_preimage at ha,
    erw ←ha2 at rid,
    apply ha1,
    exact rid },

  rw pi.zero_apply,
  unfold bmk,
  rw [homogeneous_localization.ext_iff_val, homogeneous_localization.val_mk', homogeneous_localization.zero_val],
  simp only [← subtype.val_eq_coe],
  rw [show (0 : localization.at_prime y.1.as_homogeneous_ideal.to_ideal) = localization.mk 0 1,
    by erw localization.mk_zero],
  dsimp only,
  unfold num denom,

  have eq1 := data.eq_num_div_denom hm f_deg 0 y,
  rw [data.zero, pi.zero_apply] at eq1,
  replace eq1 := eq1.symm,
  erw [show (0 : structure_sheaf.localizations (A⁰_ f_deg)
    (((Proj_iso_Spec_Top_component hm f_deg).hom) ⟨y.val, y_mem⟩)) = localization.mk 0 1,
    by erw localization.mk_zero, localization.mk_eq_mk', is_localization.eq] at eq1,

  obtain ⟨⟨⟨C, C_degree_zero⟩, hC⟩, eq1⟩ := eq1,
  induction C using localization.induction_on with 𝔻,
  obtain ⟨C, ⟨_, ⟨l, rfl⟩⟩⟩ := 𝔻,
  simp only [submonoid.coe_one, mul_one, one_mul, subtype.coe_mk] at eq1,
  simp only [zero_mul] at eq1,
  simp only [localization.mk_eq_mk', is_localization.eq],
  change _ ∉ _ at hC,
  erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff at hC,
  dsimp only [subtype.coe_mk] at C_degree_zero hC,

  have eq_num := degree_zero_part.eq (data.num hm f_deg 0 y),
  have eq_denom := degree_zero_part.eq (data.denom hm f_deg 0 y),

  rw subtype.ext_iff at eq1,
  simp only [subring.coe_mul, subtype.coe_mk] at eq1,
  rw [eq_num, subring.coe_zero,
    show (0 : localization.away f) = localization.mk 0 1, by rw localization.mk_zero,
    localization.mk_mul] at eq1,
  simp only [localization.mk_eq_mk', is_localization.eq] at eq1,
  obtain ⟨⟨_, ⟨n1, rfl⟩⟩, eq1⟩ := eq1,
  simp only [submonoid.coe_mul, ←pow_add,
    submonoid.coe_one, mul_one, zero_mul, subtype.coe_mk] at eq1,

  have C_not_mem : C ∉ y.1.as_homogeneous_ideal,
  { intro rid,
    have eq1 : (localization.mk C ⟨f ^ l, ⟨_, rfl⟩⟩ : localization.away f) =
      (localization.mk 1 ⟨f^l, ⟨_, rfl⟩⟩ : localization.away f) * localization.mk C 1,
      rw [localization.mk_mul, one_mul, mul_one],
    erw eq1 at hC,
    apply hC,
    convert ideal.mul_mem_left _ _ _,
    apply ideal.subset_span,
    refine ⟨C, rid, rfl⟩, },

  use C * f^n1,
  { intro rid,
    rcases y.1.is_prime.mem_or_mem rid with H1 | H2,
    apply C_not_mem H1,
    replace H2 := y.1.is_prime.mem_of_pow_mem _ H2,
    apply y_mem,
    exact H2, },

  simp only [submonoid.coe_one, zero_mul, mul_one],
  simp only [← subtype.val_eq_coe],

  rw calc degree_zero_part.num (data.num hm f_deg 0 y)
        * f ^ degree_zero_part.deg (data.denom hm f_deg 0 y)
        * (C * f ^ n1)
      = degree_zero_part.num (data.num hm f_deg 0 y)
        * C * f ^ n1
        * f ^ degree_zero_part.deg (data.denom hm f_deg 0 y)
      : by ring,
  rw [eq1, zero_mul],
end

lemma bmk_add (x y : (Spec (A⁰_ f_deg)).presheaf.obj V) :
  bmk hm f_deg V (x + y) = bmk hm f_deg V x + bmk hm f_deg V y :=
begin
  ext1 z,
  have z_mem : z.val ∈ (projective_spectrum.basic_open 𝒜 f).val,
  { erw projective_spectrum.mem_basic_open,
    intro rid,
    have mem1 := z.2,
    erw set.mem_preimage at mem1,
    obtain ⟨⟨a, ha1⟩, ha, ha2⟩ := mem1,
    change a = z.1 at ha2,
    erw set.mem_preimage at ha,
    erw ←ha2 at rid,
    apply ha1,
    exact rid },

  rw pi.add_apply,
  unfold bmk,
  simp only [homogeneous_localization.ext_iff_val, homogeneous_localization.val_mk', homogeneous_localization.add_val, ←subtype.val_eq_coe],
  unfold num denom,
  dsimp only,

  have add_eq := data.eq_num_div_denom hm f_deg (x + y) z,
  rw [data.add_apply, data.eq_num_div_denom, data.eq_num_div_denom, add_mk] at add_eq,
  simp only [localization.mk_eq_mk'] at add_eq,
  erw is_localization.eq at add_eq,
  obtain ⟨⟨⟨C, C_degree_zero⟩, hC⟩, add_eq⟩ := add_eq,
  induction C using localization.induction_on with 𝔻,
  obtain ⟨C, ⟨_, ⟨l, rfl⟩⟩⟩ := 𝔻,
  change _ ∉ _ at hC,
  erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff at hC,
  simp only [subtype.coe_mk] at hC,
  simp only [submonoid.coe_mul, subtype.coe_mk] at add_eq,
  rw subtype.ext_iff at add_eq,
  simp only [subring.coe_add, subring.coe_mul, subtype.coe_mk] at add_eq,

  have C_not_mem : C ∉ z.1.as_homogeneous_ideal,
  { intro rid,
    have eq1 : (localization.mk C ⟨f ^ l, ⟨_, rfl⟩⟩ : localization.away f) =
      (localization.mk 1 ⟨f^l, ⟨_, rfl⟩⟩ : localization.away f) * localization.mk C 1,
      rw [localization.mk_mul, one_mul, mul_one],
    erw eq1 at hC,
    apply hC,
    convert ideal.mul_mem_left _ _ _,
    apply ideal.subset_span,
    exact ⟨C, rid, rfl⟩, },

  simp only [degree_zero_part.eq, localization.mk_mul, localization.add_mk,
    submonoid.coe_mul] at add_eq,
  rw [localization.mk_eq_mk', is_localization.eq] at add_eq,
  obtain ⟨⟨_, ⟨n1, rfl⟩⟩, add_eq⟩ := add_eq,
  simp only [←subtype.val_eq_coe,
    submonoid.coe_mul] at add_eq,

  set a_xy : A := degree_zero_part.num (data.num hm f_deg (x + y) z) with a_xy_eq,
  set i_xy : ℕ := degree_zero_part.deg (data.num hm f_deg (x + y) z) with i_xy_eq,
  set b_xy : A := degree_zero_part.num (data.denom hm f_deg (x + y) z) with b_xy_eq,
  set j_xy : ℕ := degree_zero_part.deg (data.denom hm f_deg (x + y) z) with j_xy_eq,

  set a_x : A := degree_zero_part.num (data.num hm f_deg x z) with a_x_eq,
  set i_x : ℕ := degree_zero_part.deg (data.num hm f_deg x z) with i_x_eq,
  set b_x : A := degree_zero_part.num (data.denom hm f_deg x z) with b_x_eq,
  set j_x : ℕ := degree_zero_part.deg (data.denom hm f_deg x z) with j_x_eq,

  set a_y : A := degree_zero_part.num (data.num hm f_deg y z) with a_y_eq,
  set i_y : ℕ := degree_zero_part.deg (data.num hm f_deg y z) with i_y_eq,
  set b_y : A := degree_zero_part.num (data.denom hm f_deg y z) with b_y_eq,
  set j_y : ℕ := degree_zero_part.deg (data.denom hm f_deg y z) with j_y_eq,

  simp only [←a_xy_eq, ←i_xy_eq, ←b_xy_eq, ←j_xy_eq, ←a_x_eq, ←i_x_eq, ←b_x_eq, ←j_x_eq, ←a_y_eq, ←b_y_eq, ←i_y_eq, ←j_y_eq] at add_eq ⊢,

  rw localization.add_mk,
  simp only [←subtype.val_eq_coe,
    show ∀ (α β : z.1.as_homogeneous_ideal.to_ideal.prime_compl), α * β = ⟨α.1 * β.1, begin
      intro rid,
      rcases z.1.is_prime.mem_or_mem rid,
      apply α.2 h,
      apply β.2 h,
    end⟩,
    begin
      intros α β,
      simp only [subtype.ext_iff],
      refl,
    end,
    show b_x * f ^ i_x * (a_y * f ^ j_y) = a_y * b_x * f ^ (i_x + j_y),
    begin
      rw pow_add, ring,
    end,
    show b_y * f ^ i_y * (a_x * f ^ j_x) = a_x * b_y * f ^ (i_y + j_x),
    begin
      rw pow_add, ring
    end,
    show b_x * f ^ i_x * (b_y * f ^ i_y) = b_x * b_y * f ^ (i_x + i_y),
    begin
      rw pow_add, ring
    end],
  rw [calc (f ^ j_x * f ^ i_y * (b_y * a_x) + f ^ j_y * f ^ i_x * (b_x * a_y)) * b_xy * C
          * (f ^ i_xy * (f ^ j_x * f ^ j_y) * f ^ l) * f ^ n1
        = ((f ^ j_x * f ^ i_y) * (b_y * a_x) + (f ^ j_y * f ^ i_x) * (b_x * a_y)) * b_xy * C
          * ((f ^ i_xy * (f ^ j_x * f ^ j_y) * f ^ l) * f ^ n1) : by ring
    ... = ((f ^ (j_x + i_y)) * (b_y * a_x) + (f ^ (j_y + i_x)) * (b_x * a_y)) * b_xy * C
          * f ^ ((((i_xy + (j_x + j_y))) + l) + n1)
        : begin
          congr',
          all_goals { repeat { rw pow_add } },
        end,
      calc a_xy * (b_x * b_y) * C * (f ^ j_x * f ^ i_y * (f ^ j_y * f ^ i_x) * f ^ j_xy * f ^ l) * f ^ n1
        = a_xy * (b_x * b_y) * C * ((f ^ j_x * f ^ i_y * (f ^ j_y * f ^ i_x) * f ^ j_xy * f ^ l) * f ^ n1) : by ring
    ... = a_xy * (b_x * b_y) * C * f ^ (((((j_x + i_y) + (j_y + i_x)) + j_xy) + l) + n1) : by simp only [pow_add]] at add_eq,

  simp only [localization.mk_eq_mk', is_localization.eq],
  refine ⟨⟨C * f ^ ((j_x + j_y) + l + n1), begin
    intro rid,
    rcases z.1.is_prime.mem_or_mem rid with H1 | H2,
    apply C_not_mem H1,
    replace H2 := z.1.is_prime.mem_of_pow_mem _ H2,
    apply z_mem H2,
  end⟩, _⟩,
  simp only [←subtype.val_eq_coe],

  rw [calc (a_y * b_x * f ^ (i_x + j_y) + a_x * b_y * f ^ (i_y + j_x)) * (b_xy * f ^ i_xy)
          * (C * f ^ ((j_x + j_y) + l + n1))
        = (f ^ (i_y + j_x) * (b_y * a_x) +  f ^ (i_x + j_y) * (b_x * a_y)) * b_xy * C
          * (f ^ i_xy * f ^ ((j_x + j_y) + l + n1)) : by ring
    ... = (f ^ (i_y + j_x) * (b_y * a_x) +  f ^ (i_x + j_y) * (b_x * a_y)) * b_xy * C
          * (f ^ (i_xy + ((j_x + j_y) + l + n1))) : by simp only [pow_add]
    ... = (f ^ (j_x + i_y) * (b_y * a_x) +  f ^ (j_y + i_x) * (b_x * a_y)) * b_xy * C
          * (f ^ (i_xy + (j_x + j_y) + l + n1))
        : begin
          congr' 1,
          congr' 5,
          all_goals { simp only [add_comm, add_assoc], },
        end, add_eq],
  simp only [pow_add],
  ring,
end

lemma bmk_mul (x y : (Spec (A⁰_ f_deg)).presheaf.obj V) :
  bmk hm f_deg V (x * y) = bmk hm f_deg V x * bmk hm f_deg V y :=
begin
  ext1 z,
  have z_mem : z.val ∈ (projective_spectrum.basic_open 𝒜 f).val,
  { erw projective_spectrum.mem_basic_open,
    intro rid,
    have mem1 := z.2,
    erw set.mem_preimage at mem1,
    obtain ⟨⟨a, ha1⟩, ha, ha2⟩ := mem1,
    change a = z.1 at ha2,
    erw set.mem_preimage at ha,
    erw ←ha2 at rid,
    apply ha1,
    exact rid, },

  rw pi.mul_apply,
  unfold bmk,
  simp only [homogeneous_localization.ext_iff_val, homogeneous_localization.val_mk', homogeneous_localization.mul_val, ← subtype.val_eq_coe],
  unfold num denom,

  have mul_eq := data.eq_num_div_denom hm f_deg (x * y) z,
  rw [data.mul_apply, data.eq_num_div_denom, data.eq_num_div_denom, localization.mk_mul] at mul_eq,
  simp only [localization.mk_eq_mk'] at mul_eq,
  erw is_localization.eq at mul_eq,
  obtain ⟨⟨⟨C, C_degree_zero⟩, hC⟩, mul_eq⟩ := mul_eq,
  induction C using localization.induction_on with 𝔻,
  obtain ⟨C, ⟨_, ⟨l, rfl⟩⟩⟩ := 𝔻,
  change _ ∉ _ at hC,
  erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff at hC,
  simp only [subtype.coe_mk] at hC,
  simp only [←subtype.val_eq_coe] at mul_eq,
  rw subtype.ext_iff at mul_eq,

  have C_not_mem : C ∉ z.1.as_homogeneous_ideal,
  { intro rid,
    have eq1 : (localization.mk C ⟨f ^ l, ⟨_, rfl⟩⟩ : localization.away f) =
      (localization.mk 1 ⟨f^l, ⟨_, rfl⟩⟩ : localization.away f) * localization.mk C 1,
      rw [localization.mk_mul, one_mul, mul_one],
    erw eq1 at hC,
    apply hC,
    convert ideal.mul_mem_left _ _ _,
    apply ideal.subset_span,
    exact ⟨C, rid, rfl⟩, },

  simp only [subring.coe_mul, coe_add, subtype.coe_mk,
    show ∀ (α β : (prime_spectrum.as_ideal (((Proj_iso_Spec_Top_component hm f_deg).hom)
      ⟨z.val, z_mem⟩)).prime_compl),
      (α * β).1 = α.1 * β.1, from λ _ _, rfl] at mul_eq,
  simp only [degree_zero_part.eq, localization.mk_mul, localization.add_mk,
    submonoid.coe_mul] at mul_eq,
  rw [localization.mk_eq_mk', is_localization.eq] at mul_eq,
  obtain ⟨⟨_, ⟨n1, rfl⟩⟩, mul_eq⟩ := mul_eq,
  simp only [←subtype.val_eq_coe,
    submonoid.coe_mul] at mul_eq,

  set a_xy : A := degree_zero_part.num (data.num hm f_deg (x * y) z) with a_xy_eq,
  set i_xy : ℕ := degree_zero_part.deg (data.num hm f_deg (x * y) z) with i_xy_eq,
  set b_xy : A := degree_zero_part.num (data.denom hm f_deg (x * y) z) with b_xy_eq,
  set j_xy : ℕ := degree_zero_part.deg (data.denom hm f_deg (x * y) z) with j_xy_eq,

  set a_x : A := degree_zero_part.num (data.num hm f_deg x z) with a_x_eq,
  set i_x : ℕ := degree_zero_part.deg (data.num hm f_deg x z) with i_x_eq,
  set b_x : A := degree_zero_part.num (data.denom hm f_deg x z) with b_x_eq,
  set j_x : ℕ := degree_zero_part.deg (data.denom hm f_deg x z) with j_x_eq,

  set a_y : A := degree_zero_part.num (data.num hm f_deg y z) with a_y_eq,
  set i_y : ℕ := degree_zero_part.deg (data.num hm f_deg y z) with i_y_eq,
  set b_y : A := degree_zero_part.num (data.denom hm f_deg y z) with b_y_eq,
  set j_y : ℕ := degree_zero_part.deg (data.denom hm f_deg y z) with j_y_eq,

  simp only [←a_xy_eq, ←i_xy_eq, ←b_xy_eq, ←j_xy_eq, ←a_x_eq, ←i_x_eq, ←b_x_eq, ←j_x_eq, ←a_y_eq, ←b_y_eq, ←i_y_eq, ←j_y_eq] at mul_eq ⊢,
  rw [localization.mk_mul, localization.mk_eq_mk', is_localization.eq],
  refine ⟨⟨C * f^(l + n1), begin
    intro rid,
    rcases z.1.is_prime.mem_or_mem rid with H1 | H2,
    apply C_not_mem H1,
    replace H2 := z.1.is_prime.mem_of_pow_mem _ H2,
    apply z_mem H2,
  end⟩, _⟩,
  simp only [←subtype.val_eq_coe,
    show ∀ (α β : z.1.as_homogeneous_ideal.to_ideal.prime_compl), (α * β).1 = α.1 * β.1,
    from λ _ _, rfl],
  simp only [pow_add],
  ring_nf at mul_eq ⊢,
  rw mul_eq,
end

namespace is_locally_quotient

variable {V}
lemma mem_pbo : y.1 ∈ pbo f :=
begin
  rw projective_spectrum.mem_basic_open,
  intro rid,
  have mem1 := y.2,
  erw set.mem_preimage at mem1,
  obtain ⟨⟨a, ha1⟩, ha, ha2⟩ := mem1,
  erw set.mem_preimage at ha,
  erw ←ha2 at rid,
  apply ha1,
  exact rid,
end

lemma hom_apply_mem :
  (Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, mem_pbo hm f_deg y⟩ ∈ unop V :=
begin
  obtain ⟨a, ha1, ha2⟩ := y.2,
  erw set.mem_preimage at ha1,
  change ((Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, _⟩) ∈ (unop V).1,
  convert ha1,
  rw subtype.ext_iff,
  exact ha2.symm,
end

def Uo (VV : opens (Spec.T (A⁰_ f_deg))) :
  opens (projective_spectrum.Top 𝒜) :=
⟨{x | ∃ x' : homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg) ⁻¹' VV.1, x = x'.1.1}, begin
  have O1 := (homeomorph.is_open_preimage (homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg))).2 VV.2,
  rw is_open_induced_iff at O1,
  obtain ⟨s, Os, set_eq1⟩ := O1,
  have O2 : is_open (s ∩ (projective_spectrum.basic_open 𝒜 f).1),
  apply is_open.inter Os (projective_spectrum.basic_open 𝒜 f).2,
  convert O2,
  ext γ, split; intros hγ,
  { obtain ⟨x', rfl⟩ := hγ,
    have mem1 := x'.2,
    simp only [←set_eq1] at mem1,
    erw set.mem_preimage at mem1,
    refine ⟨mem1, _⟩,
    have mem2 := x'.2,
    rw set.mem_preimage at mem2,
    intro rid,
    have mem3 : (⟨localization.mk f ⟨f^1, ⟨_, rfl⟩⟩, ⟨1, ⟨_, by simpa [mul_one] using f_deg⟩, rfl⟩⟩ : A⁰_ f_deg) ∈ ((Proj_iso_Spec_Top_component hm f_deg).hom x'.1).as_ideal,
    { erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff,
      change (localization.mk f ⟨f^1, ⟨_, rfl⟩⟩ : localization.away f) ∈ ideal.span _,
      convert ideal.mul_mem_left _ _ _,
      work_on_goal 2
      { exact mk 1 ⟨f^1, ⟨_, rfl⟩⟩ },
      work_on_goal 2
      { exact mk f 1 },
      { rw [mk_mul, one_mul, mul_one], },
      { apply ideal.subset_span,
        refine ⟨f, rid, rfl⟩, } },
    have mem4 : (1 : A⁰_ f_deg) ∈ ((Proj_iso_Spec_Top_component hm f_deg).hom x'.1).as_ideal,
    { convert mem3,
      rw [subtype.ext_iff, subring.coe_one],
      dsimp only [subtype.coe_mk],
      symmetry,
      convert localization.mk_self _,
      erw [←subtype.val_eq_coe],
      dsimp only,
      rw pow_one, },
    apply ((Proj_iso_Spec_Top_component hm f_deg).hom x'.1).is_prime.1,
    rw ideal.eq_top_iff_one,
    exact mem4, },

  { rcases hγ with ⟨hγ1, hγ2⟩,
    use ⟨γ, hγ2⟩,
    rw [←set_eq1, set.mem_preimage],
        convert hγ1, }
end⟩

lemma subset2 (VV : opens (Spec.T (A⁰_ f_deg)))
  (subset1 : VV ⟶ unop V) :
  Uo hm f_deg VV ⟶
  (((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
        ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj V)).unop) :=
begin
  apply hom_of_le,
  intros γ γ_mem,
  change γ ∈ _ at γ_mem,
  replace subset3 := le_of_hom subset1,
  obtain ⟨⟨γ, γ_mem⟩, rfl⟩ := γ_mem,
  erw set.mem_preimage at γ_mem,
  refine ⟨γ, _, _⟩,
  erw set.mem_preimage,
  apply subset3,
  exact γ_mem,
  rw subtype.ext_iff,
  dsimp only,
  rw show (opens.inclusion _ γ = γ.1), from rfl,
end

end is_locally_quotient

lemma is_locally_quotient :
  ∃ (U : opens _) (mem : y.val ∈ U)
    (subset1 : U ⟶
      (((@opens.open_embedding (projective_spectrum.Top 𝒜) (projective_spectrum.basic_open 𝒜 f)).is_open_map.functor.op.obj
        ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj V)).unop))
    (a b : A) (degree : ℕ) (a_hom : a ∈ 𝒜 degree) (b_hom : b ∈ 𝒜 degree),
    ∀ (x : U),
      ∃ (s_nin : b ∉ projective_spectrum.as_homogeneous_ideal x.val),
        (bmk hm f_deg V hh ⟨x.1, (subset1 x).2⟩).val = mk a ⟨b, s_nin⟩ :=
begin
  have y_mem : y.val ∈ projective_spectrum.basic_open 𝒜 f,
  { convert is_locally_quotient.mem_pbo hm f_deg y, },

  have hom_y_mem : (Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, y_mem⟩ ∈ unop V,
  { convert is_locally_quotient.hom_apply_mem hm f_deg y, },
  have is_local := hh.2,
  rw structure_sheaf.is_locally_fraction_pred' at is_local,
  specialize is_local ⟨(Proj_iso_Spec_Top_component hm f_deg).hom ⟨y.1, y_mem⟩, hom_y_mem⟩,
  obtain ⟨VV, hom_y_mem_VV, subset1, ⟨α, ⟨l1, ⟨α', α'_mem⟩, rfl⟩⟩, ⟨β, ⟨l2, ⟨β', β'_mem⟩, rfl⟩⟩, is_local⟩ := is_local,

  set U := is_locally_quotient.Uo hm f_deg VV with U_eq,

  have y_mem_U : y.1 ∈ U,
  { use ⟨y.1, y_mem⟩,
    rw set.mem_preimage,
    exact hom_y_mem_VV, },

  set subset2 : U ⟶ _ := is_locally_quotient.subset2 hm f_deg VV subset1,
  refine ⟨U, y_mem_U, subset2, α' * f^l2, β' * f^l1, m * l1 + l2 * m,
    set_like.graded_monoid.mul_mem α'_mem (set_like.graded_monoid.pow_mem _ f_deg),
    by { convert set_like.graded_monoid.mul_mem β'_mem (set_like.graded_monoid.pow_mem _ f_deg) using 2, rw [smul_eq_mul], ring, }, _⟩,

  rintros ⟨z, z_mem_U⟩,
  have z_mem_bo : z ∈ pbo f,
  { obtain ⟨⟨z, hz⟩, rfl⟩ := z_mem_U,
    rw set.mem_preimage at hz,
    apply z.2, },

  have hom_z_mem_VV : ((Proj_iso_Spec_Top_component hm f_deg).hom) ⟨z, z_mem_bo⟩ ∈ VV,
  { obtain ⟨γ, h1, h2⟩ := z_mem_U,
    have mem1 := γ.2,
    erw set.mem_preimage at mem1,
    exact mem1, },

  specialize is_local ⟨((Proj_iso_Spec_Top_component hm f_deg).hom ⟨z, z_mem_bo⟩), hom_z_mem_VV⟩,
  obtain ⟨not_mem1, eq1⟩ := is_local,

  have not_mem2 : β' * f ^ l1 ∉ z.as_homogeneous_ideal,
  { intro rid,
    rcases z.is_prime.mem_or_mem rid with H1 | H2,
    { apply not_mem1,
      have eq2 : (localization.mk β' ⟨f^l2, ⟨_, rfl⟩⟩ : localization.away f) =
        localization.mk 1 ⟨f^l2, ⟨_, rfl⟩⟩ * localization.mk β' 1,
      { rw [localization.mk_mul, one_mul, mul_one], },
      simp only [eq2],
      erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff,
      dsimp only,
      convert ideal.mul_mem_left _ _ _,
      apply ideal.subset_span,
      refine ⟨β', H1, rfl⟩, },
    { replace H2 := z.is_prime.mem_of_pow_mem _ H2,
      exact z_mem_bo H2, } },
  refine ⟨not_mem2, _⟩,
  have data_eq : data hm f_deg hh (subset2 ⟨z, z_mem_U⟩) =
    hh.val (subset1 ⟨((Proj_iso_Spec_Top_component hm f_deg).hom) ⟨z, z_mem_bo⟩, hom_z_mem_VV⟩),
  { congr', },
  rw ←data_eq at eq1,

  have z_mem2 : z ∈ (((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
        ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj V)).unop),
  { use z,
    refine ⟨_, rfl⟩,
    erw set.mem_preimage,
    apply (le_of_hom subset1),
    exact hom_z_mem_VV, },

  have data_eq2 : data hm f_deg hh (subset2 ⟨z, z_mem_U⟩) = data hm f_deg hh ⟨z, z_mem2⟩,
  { congr', },
  rw [data_eq2, data.eq_num_div_denom, localization.mk_eq_mk'] at eq1,
  erw is_localization.eq at eq1,

  obtain ⟨⟨⟨_, ⟨L, ⟨C, C_mem⟩, rfl⟩⟩, hC⟩, eq1⟩ := eq1,
  simp only [subtype.ext_iff, subring.coe_mul] at eq1,
  simp only [degree_zero_part.eq, localization.mk_mul, subtype.coe_mk] at eq1,
  erw [localization.mk_eq_mk', is_localization.eq] at eq1,
  obtain ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩ := eq1,
  simp only [←subtype.val_eq_coe,
    submonoid.coe_mul, ←pow_add] at eq1,

  unfold bmk,
  rw [homogeneous_localization.val_mk'],
  simp only [← subtype.val_eq_coe],
  unfold num denom,

  set p := degree_zero_part.num (data.num hm f_deg hh ⟨z, z_mem2⟩) with p_eq,
  set q := degree_zero_part.num (data.denom hm f_deg hh ⟨z, z_mem2⟩) with q_eq,
  set ii := degree_zero_part.deg (data.num hm f_deg hh ⟨z, z_mem2⟩) with ii_eq,
  set jj := degree_zero_part.deg (data.denom hm f_deg hh ⟨z, z_mem2⟩) with jj_eq,

  simp only [localization.mk_eq_mk', is_localization.eq],

  have C_not_mem : C ∉ z.as_homogeneous_ideal,
  { intro rid,
    have eq1 : (localization.mk C ⟨f ^ L, ⟨_, rfl⟩⟩ : localization.away f) =
      (localization.mk 1 ⟨f^L, ⟨_, rfl⟩⟩ : localization.away f) * localization.mk C 1,
      rw [localization.mk_mul, one_mul, mul_one],
    simp only [eq1, subtype.coe_mk] at hC,
    apply hC,
    change _ * _ ∈ _,
    rw [set_like.mem_coe],
    convert ideal.mul_mem_left _ _ _,
    apply ideal.subset_span,
    refine ⟨C, rid, rfl⟩ },

  refine ⟨⟨C * f^(L+M), begin
    intro rid,
    rcases z.is_prime.mem_or_mem rid with H1 | H2,
    apply C_not_mem H1,
    replace H2 := z.is_prime.mem_of_pow_mem _ H2,
    apply z_mem_bo,
    exact H2,
  end⟩, _⟩,

  simp only [←subtype.val_eq_coe,
    submonoid.coe_mul],

  suffices EQ : p * f^jj * (β' * f^l1) * (C * f^(L+M)) = α' * f^l2 * (q * f^ii) * (C * f^(L + M)),
  convert EQ,
  rw calc p * f^jj * (β' * f^l1) * (C * f^(L+M))
        = p * f^jj * (β' * f^l1) * (C * (f^L * f^M)) : by simp only [pow_add]
    ... = p * β' * C * (f^l1 * f^jj * f^L) * f^M : by ring
    ... = p * β' * C * f^(l1 + jj + L) * f^M : by simp only [pow_add]
    ... = α' * q * C * f ^ (ii + l2 + L) * f ^ M : by rw eq1,

  simp only [pow_add],
  ring,
end

def to_fun.aux (hh : (Spec (A⁰_ f_deg)).presheaf.obj V) : ((Proj_iso_Spec_Top_component hm f_deg).hom _* (Proj| (pbo f)).presheaf).obj V :=
⟨bmk hm f_deg V hh, λ y, begin
  rcases is_locally_quotient hm f_deg V hh y with ⟨VV, mem1, subset1, a, b, degree, a_mem, b_mem, l⟩,
  refine ⟨VV, mem1, subset1, degree, ⟨a, a_mem⟩, ⟨b, b_mem⟩, λ x, _⟩,
  rcases l x with ⟨s_nin, l⟩,
  refine ⟨s_nin, _⟩,
  dsimp only,
  rw [homogeneous_localization.ext_iff_val, homogeneous_localization.val_mk'],
  simp only [← subtype.val_eq_coe],
  erw ← l,
  rw ← homogeneous_localization.ext_iff_val,
  congr' 1
end⟩

def to_fun : (Spec (A⁰_ f_deg)).presheaf.obj V ⟶ ((Proj_iso_Spec_Top_component hm f_deg).hom _* (Proj| (pbo f)).presheaf).obj V :=
{ to_fun := λ hh, to_fun.aux hm f_deg V hh,
  map_one' := begin
    rw subtype.ext_iff,
    convert bmk_one hm f_deg V,
  end,
  map_mul' := λ x y, begin
    rw subtype.ext_iff,
    convert bmk_mul hm f_deg V x y,
  end,
  map_zero' := begin
    rw subtype.ext_iff,
    convert bmk_zero hm f_deg V,
  end,
  map_add' := λ x y, begin
    rw subtype.ext_iff,
    convert bmk_add hm f_deg V x y,
  end }

end from_Spec

def from_Spec {f : A} {m : ℕ} (hm : 0 < m) (f_deg : f ∈ 𝒜 m) :
  (Spec (A⁰_ f_deg)).presheaf ⟶ (Proj_iso_Spec_Top_component hm f_deg).hom _* (Proj| (pbo f)).presheaf :=
{ app := λ V, from_Spec.to_fun hm f_deg V,
  naturality' := λ U V subset1, begin
    ext1 z,
    simp only [comp_apply, ring_hom.coe_mk, functor.op_map, presheaf.pushforward_obj_map],
    refl,
  end }

end Proj_iso_Spec_Sheaf_component

end algebraic_geometry


import ReactorModel.Determinism.ExecutionStep
import ReactorModel.Determinism.Trivial

open Classical ReactorType

variable [Indexable α] {s s₁ s₂ : State α}

namespace Execution

theorem tag_le {s₁ s₂ : State α} : (s₁ ⇓* s₂) → s₁.tag ≤ s₂.tag
  | refl      => le_refl _
  | step e e' => le_trans e.tag_le e'.tag_le

theorem seq_progress_ssubset_or_tag_lt [State.Nontrivial s₁] :
    (s₁ ⇓ s₂) → (s₂ ⇓* s₃) → (s₁.progress ⊂ s₃.progress) ∨ (s₁.tag < s₃.tag)
  | e₁₂,        .step e e' => .inr $ lt_of_lt_of_le (e₁₂.seq_tag_lt e) e'.tag_le
  | .close e,   .refl      => .inl $ e.progress_ssubset
  | .advance a, .refl      => .inr $ a.tag_lt

theorem nontrivial_deterministic {s s₁ s₂ : State α} [State.Nontrivial s] :
    (s ⇓* s₁) → (s ⇓* s₂) → (s₁.tag = s₂.tag) → (s₁.progress = s₂.progress) → s₁ = s₂
  | refl, refl, _, _ => rfl
  | step e₁ e₁', step e₂ e₂', ht, hp =>
    have := e₂.preserves_Nontrivial -- TODO: Make this work via type class inference.
    nontrivial_deterministic (e₁.deterministic e₂ ▸ e₁') e₂' ht hp
  | refl, step e e', ht, hp | step e e', refl, ht, hp =>
    match seq_progress_ssubset_or_tag_lt e e' with
    | .inl h => absurd hp $ Set.ssubset_ne (by simp_all)
    | .inr h => absurd ht $ ne_of_lt (by simp_all)

theorem deterministic :
    (s ⇓* s₁) → (s ⇓* s₂) → (s₁.tag = s₂.tag) → (s₁.progress = s₂.progress) → s₁ = s₂ :=
  if h : State.Nontrivial s
  then nontrivial_deterministic
  else fun e₁ e₂ ht _ => e₁.trivial_deterministic h e₂ ht

end Execution


import category_theory.triangulated.pretriangulated

noncomputable theory

namespace category_theory

open limits category preadditive
open_locale zero_object

namespace pretriangulated

variables {C : Type*} [category C] [preadditive C] [has_shift C ℤ]

@[simps]
def triangle.mk_iso (T T' : triangle C) (e₁ : T.obj₁ ≅ T'.obj₁) (e₂ : T.obj₂ ≅ T'.obj₂)
  (e₃ : T.obj₃ ≅ T'.obj₃)
  (comm₁ : T.mor₁ ≫ e₂.hom = e₁.hom ≫ T'.mor₁)
  (comm₂ : T.mor₂ ≫ e₃.hom = e₂.hom ≫ T'.mor₂)
  (comm₃ : T.mor₃ ≫ (shift_functor C 1).map e₁.hom = e₃.hom ≫ T'.mor₃) : T ≅ T' :=
{ hom :=
  { hom₁ := e₁.hom,
    hom₂ := e₂.hom,
    hom₃ := e₃.hom,
    comm₁' := comm₁,
    comm₂' := comm₂,
    comm₃' := comm₃, },
  inv :=
  { hom₁ := e₁.inv,
    hom₂ := e₂.inv,
    hom₃ := e₃.inv,
    comm₁' := by rw [← cancel_mono e₂.hom, assoc, e₂.inv_hom_id, comp_id, assoc, comm₁, e₁.inv_hom_id_assoc],
    comm₂' := by { rw [← cancel_mono e₃.hom, assoc, e₃.inv_hom_id, comp_id, assoc, comm₂, e₂.inv_hom_id_assoc], },
    comm₃' := by { rw [← cancel_epi e₃.hom, ← assoc, ← comm₃, assoc, ← functor.map_comp, e₁.hom_inv_id, functor.map_id, comp_id, e₃.hom_inv_id_assoc], }, },
  hom_inv_id' := by { ext; apply iso.hom_inv_id, },
  inv_hom_id' := by { ext; apply iso.inv_hom_id, }, }

@[simp, reassoc]
lemma triangle.hom_inv_id_hom₁ {T T' : triangle C} (e : T ≅ T') :
  e.hom.hom₁ ≫ e.inv.hom₁ = 𝟙 _ :=
by { change (e.hom ≫ e.inv).hom₁ = _, simpa only [e.hom_inv_id], }

@[simp, reassoc]
lemma triangle.inv_hom_id_hom₁ {T T' : triangle C} (e : T ≅ T') :
  e.inv.hom₁ ≫ e.hom.hom₁ = 𝟙 _ :=
by { change (e.inv ≫ e.hom).hom₁ = _, simpa only [e.inv_hom_id], }

@[simp, reassoc]
lemma triangle.hom_inv_id_hom₂ {T T' : triangle C} (e : T ≅ T') :
  e.hom.hom₂ ≫ e.inv.hom₂ = 𝟙 _ :=
by { change (e.hom ≫ e.inv).hom₂ = _, simpa only [e.hom_inv_id], }

@[simp, reassoc]
lemma triangle.inv_hom_id_hom₂ {T T' : triangle C} (e : T ≅ T') :
  e.inv.hom₂ ≫ e.hom.hom₂ = 𝟙 _ :=
by { change (e.inv ≫ e.hom).hom₂ = _, simpa only [e.inv_hom_id], }
@[simp, reassoc]

lemma triangle.hom_inv_id_hom₃ {T T' : triangle C} (e : T ≅ T') :
  e.hom.hom₃ ≫ e.inv.hom₃ = 𝟙 _ :=
by { change (e.hom ≫ e.inv).hom₃ = _, simpa only [e.hom_inv_id], }

@[simp, reassoc]
lemma triangle.inv_hom_id_hom₃ {T T' : triangle C} (e : T ≅ T') :
  e.inv.hom₃ ≫ e.hom.hom₃ = 𝟙 _ :=
by { change (e.inv ≫ e.hom).hom₃ = _, simpa only [e.inv_hom_id], }

lemma triangle.is_iso_of_is_iso_homs {T T' : triangle C} (f : T ⟶ T')
  (h₁ : is_iso f.hom₁) (h₂ : is_iso f.hom₂) (h₃ : is_iso f.hom₃) : is_iso f :=
begin
  haveI := h₁,
  haveI := h₂,
  haveI := h₃,
  convert is_iso.of_iso (triangle.mk_iso T T' (as_iso f.hom₁) (as_iso f.hom₂) (as_iso f.hom₃)
    f.comm₁ f.comm₂ f.comm₃),
  ext; refl,
end

section
variables [∀ (n : ℤ), functor.additive (shift_functor C n)] [has_zero_object C] [pretriangulated C]

@[reassoc]
lemma triangle.comp_zero₁₂ (T : triangle C) (hT : T ∈ dist_triang C) : T.mor₁ ≫ T.mor₂ = 0 :=
begin
  obtain ⟨c, ⟨hc₁, hc₂⟩⟩ := complete_distinguished_triangle_morphism _ _
    (contractible_distinguished T.obj₁) hT (𝟙 T.obj₁) T.mor₁ rfl,
  dsimp at hc₁,
  rw [← hc₁, zero_comp],
end

@[reassoc]
lemma triangle.comp_zero₂₃ (T : triangle C) (hT : T ∈ dist_triang C) : T.mor₂ ≫ T.mor₃ = 0 :=
triangle.comp_zero₁₂ _ (rot_of_dist_triangle _ _ hT)

@[reassoc]
lemma triangle.comp_zero₃₁ (T : triangle C) (hT : T ∈ dist_triang C) : T.mor₃ ≫ T.mor₁⟦1⟧' = 0 :=
begin
  rw [← neg_inj, ← comp_neg, neg_zero],
  exact triangle.comp_zero₁₂ _ (rot_of_dist_triangle _ _ (rot_of_dist_triangle _ _ hT)),
end

lemma distinguished_cocone_triangle₂ {Z X : C} (h : Z ⟶ X⟦(1 : ℤ)⟧) :
  ∃ (Y : C) (f : X ⟶ Y) (g : Y ⟶ Z), triangle.mk f g h ∈ dist_triang C :=
begin
  obtain ⟨Y', f', g', mem⟩ := pretriangulated.distinguished_cocone_triangle _ _ h,
  let T := triangle.mk h f' g',
  change T ∈ dist_triang C at mem,
  let T' := T.inv_rotate.inv_rotate,
  let e₁ := (shift_functor_comp_shift_functor_neg C (1 : ℤ)).app X,
  let e₂ := (shift_functor_neg_comp_shift_functor C (1 : ℤ)).app ((shift_functor C (1 : ℤ)).obj X),
  let T'' := triangle.mk (e₁.inv ≫ T'.mor₁) T'.mor₂ (T'.mor₃ ≫ e₂.hom),
  let e₃ : T' ≅ T'' := begin
    dsimp only [T', T'', triangle.mk],
    refine triangle.mk_iso _ _ e₁ (iso.refl _) (iso.refl _) _ _ _,
    { dsimp only [iso.refl],
      rw [comp_id, e₁.hom_inv_id_assoc], },
    { dsimp only [iso.refl],
      rw [comp_id, id_comp], },
    { dsimp only [iso.refl],
      rw id_comp,
      congr' 1,
      have h : (shift_functor C 1).map e₁.inv ≫ e₂.hom = 𝟙 _ := shift_equiv_triangle (1 : ℤ) X,
      rw [← cancel_epi ((shift_functor C (1 : ℤ)).map e₁.inv), h, ← functor.map_comp,
        iso.inv_hom_id, functor.map_id], },
  end,
  have eq : h = T'.mor₃ ≫ e₂.hom,
  { dsimp,
    simp only [unit_of_tensor_iso_unit_inv_app, ε_app_obj, discrete.functor_map_id,
      nat_trans.id_app, id_comp, assoc, ε_inv_app_obj, μ_inv_hom_app_assoc],
    erw comp_id, },
  rw eq,
  refine ⟨T''.obj₂, T''.mor₁, T''.mor₂, _⟩,
  exact pretriangulated.isomorphic_distinguished _
    (inv_rot_of_dist_triangle _ _ (inv_rot_of_dist_triangle _ _ mem)) _ e₃.symm,
end

lemma distinguished_cocone_triangle₁ {Y Z : C} (g : Y ⟶ Z) :
  ∃ (X : C) (f : X ⟶ Y) (h : Z ⟶ X⟦1⟧), triangle.mk f g h ∈ dist_triang C :=
begin
  obtain ⟨X', f', g', mem⟩ := pretriangulated.distinguished_cocone_triangle _ _ g,
  exact ⟨_, _, _, inv_rot_of_dist_triangle _ _ mem⟩,
end

lemma complete_distinguished_triangle_morphism₁ (T₁ T₂ : triangle C)
  (hT₁ : T₁ ∈ dist_triang C) (hT₂ : T₂ ∈ dist_triang C) (b : T₁.obj₂ ⟶ T₂.obj₂)
  (c : T₁.obj₃ ⟶ T₂.obj₃) (comm : T₁.mor₂ ≫ c = b ≫ T₂.mor₂) :
  ∃ (a : T₁.obj₁ ⟶ T₂.obj₁), T₁.mor₁ ≫ b = a ≫ T₂.mor₁ ∧
    T₁.mor₃ ≫ (shift_functor C (1 : ℤ)).map a = c ≫ T₂.mor₃ :=
begin
  obtain ⟨a, ⟨ha₁, ha₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism _ _
    (rot_of_dist_triangle _ _ hT₁) (rot_of_dist_triangle _ _ hT₂) b c comm,
  refine ⟨(shift_functor C (1 : ℤ)).preimage a, ⟨_, _⟩⟩,
  { apply (shift_functor C (1 : ℤ)).map_injective,
    dsimp at ha₂,
    rw [neg_comp, comp_neg, neg_inj] at ha₂,
    simpa only [functor.map_comp, functor.image_preimage] using ha₂, },
  { simpa only [functor.image_preimage] using ha₁, },
end

lemma complete_distinguished_triangle_morphism₂ (T₁ T₂ : triangle C)
  (hT₁ : T₁ ∈ dist_triang C) (hT₂ : T₂ ∈ dist_triang C) (a : T₁.obj₁ ⟶ T₂.obj₁)
  (c : T₁.obj₃ ⟶ T₂.obj₃) (comm : T₁.mor₃ ≫ (shift_functor C (1 : ℤ)).map a = c ≫ T₂.mor₃) :
  ∃ (b : T₁.obj₂ ⟶ T₂.obj₂), T₁.mor₁ ≫ b = a ≫ T₂.mor₁ ∧ T₁.mor₂ ≫ c = b ≫ T₂.mor₂ :=
begin
  obtain ⟨a, ⟨ha₁, ha₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism _ _
    (inv_rot_of_dist_triangle _ _ hT₁) (inv_rot_of_dist_triangle _ _ hT₂)
      ((shift_functor C (-1 : ℤ)).map c) a begin
    dsimp only [triangle.inv_rotate, triangle.mk],
    simp only [neg_comp, comp_neg, neg_inj, assoc, ← functor.map_comp_assoc, ← comm,
      iso.app_hom, unit_of_tensor_iso_unit_hom_app, discrete.functor_map_id,
      nat_trans.id_app, id_comp, assoc, functor.map_comp, μ_naturality_assoc,
      nat_trans.naturality, functor.id_map],
  end,
  refine ⟨a, ⟨ha₁, _⟩⟩,
  dsimp at ha₂,
  erw [assoc, ← nat_trans.naturality, functor.id_map] at ha₂,
  simp only [← cancel_mono ((shift_functor_neg_comp_shift_functor C (1 : ℤ)).inv.app T₂.obj₃),
    assoc, ha₂],
end

lemma contractible_distinguished₁ (X : C) : triangle.mk (0 : 0 ⟶ X) (𝟙 X) 0 ∈ dist_triang C :=
begin
  refine pretriangulated.isomorphic_distinguished _ (inv_rot_of_dist_triangle C _ (pretriangulated.contractible_distinguished X)) _ _,
  refine triangle.mk_iso _ _ (functor.map_zero_object _).symm (iso.refl _) (iso.refl _)
    (by tidy) (by tidy) (by tidy),
end

lemma contravariant_yoneda_exact₂ (T : triangle C) (hT : T ∈ dist_triang C) {X : C} (f : T.obj₂ ⟶ X)
  (hf : T.mor₁ ≫ f = 0) : ∃ (g : T.obj₃ ⟶ X), f = T.mor₂ ≫ g :=
begin
  obtain ⟨g, ⟨hg₁, hg₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism T (triangle.mk (0 : 0 ⟶ X) (𝟙 _) 0) hT
    (pretriangulated.contractible_distinguished₁ _) 0 f (by tidy),
  dsimp at hg₁,
  exact ⟨g, by simpa only [comp_id] using hg₁.symm⟩,
end

lemma covariant_yoneda_exact₂ (T : triangle C) (hT : T ∈ dist_triang C) {X : C} (f : X ⟶ T.obj₂)
  (hf : f ≫ T.mor₂ = 0) : ∃ (g : X ⟶ T.obj₁), f = g ≫ T.mor₁ :=
begin
  obtain ⟨a, ⟨ha₁, ha₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism₁ _ T
    (pretriangulated.contractible_distinguished X) hT f 0 (by { dsimp, rw [zero_comp, hf]}),
  dsimp at ha₁,
  exact ⟨a, by simpa only [id_comp] using ha₁⟩,
end

lemma covariant_yoneda_exact₁ (T : triangle C) (hT : T ∈ dist_triang C) {X : C} (f : X ⟶ T.obj₁⟦(1 : ℤ)⟧)
  (hf : f ≫ T.mor₁⟦1⟧' = 0) : ∃ (g : X ⟶ T.obj₃), f = g ≫ T.mor₃ :=
covariant_yoneda_exact₂ _ (rot_of_dist_triangle _ _
  (rot_of_dist_triangle _ _ hT)) f (by { dsimp, rw [comp_neg, hf, neg_zero], })

lemma covariant_yoneda_exact₃ (T : triangle C) (hT : T ∈ dist_triang C) {X : C} (f : X ⟶ T.obj₃)
  (hf : f ≫ T.mor₃ = 0) : ∃ (g : X ⟶ T.obj₂), f = g ≫ T.mor₂ :=
covariant_yoneda_exact₂ _ (rot_of_dist_triangle _ _ hT) f hf

lemma isomorphic_distinguished_iff {T₁ T₂ : triangle C} (e : T₁ ≅ T₂) :
  (T₁ ∈ dist_triang C) ↔ T₂ ∈ dist_triang C :=
begin
  split,
  { intro hT₁,
    exact isomorphic_distinguished _ hT₁ _ e.symm, },
  { intro hT₂,
    exact isomorphic_distinguished _ hT₂ _ e, },
end

lemma inv_rotate_distinguished_triangle (T : triangle C) :
  (T.inv_rotate ∈ dist_triang C) ↔ T ∈ dist_triang C :=
begin
  split,
  { intro hT,
    exact isomorphic_distinguished _ (rot_of_dist_triangle _ _ hT) _
      ((triangle_rotation C).counit_iso.symm.app T), },
  { intro hT,
    exact inv_rot_of_dist_triangle _ T hT, },
end

end

variable (C)

@[simps]
def contractible_triangle_functor [has_zero_object C] : C ⥤ triangle C :=
{ obj := λ X, contractible_triangle X,
  map := λ X Y f,
  { hom₁ := f,
    hom₂ := f,
    hom₃ := 0, }, }

end pretriangulated

end category_theory