/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module algebra.direct_sum.ring
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GradedMonoid
import Mathbin.Algebra.DirectSum.Basic

/-!
# Additively-graded multiplicative structures on `⨁ i, A i`

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over `⨁ i, A i` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an
additively-graded ring. The typeclasses are:

* `direct_sum.gnon_unital_non_assoc_semiring A`
* `direct_sum.gsemiring A`
* `direct_sum.gring A`
* `direct_sum.gcomm_semiring A`
* `direct_sum.gcomm_ring A`

Respectively, these imbue the external direct sum `⨁ i, A i` with:

* `direct_sum.non_unital_non_assoc_semiring`, `direct_sum.non_unital_non_assoc_ring`
* `direct_sum.semiring`
* `direct_sum.ring`
* `direct_sum.comm_semiring`
* `direct_sum.comm_ring`

the base ring `A 0` with:

* `direct_sum.grade_zero.non_unital_non_assoc_semiring`,
  `direct_sum.grade_zero.non_unital_non_assoc_ring`
* `direct_sum.grade_zero.semiring`
* `direct_sum.grade_zero.ring`
* `direct_sum.grade_zero.comm_semiring`
* `direct_sum.grade_zero.comm_ring`

and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication:

* `direct_sum.grade_zero.has_smul (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)`
* `direct_sum.grade_zero.module (A 0)`
* (nothing)
* (nothing)
* (nothing)

Note that in the presence of these instances, `⨁ i, A i` itself inherits an `A 0`-action.

`direct_sum.of_zero_ring_hom : A 0 →+* ⨁ i, A i` provides `direct_sum.of A 0` as a ring
homomorphism.

`direct_sum.to_semiring` extends `direct_sum.to_add_monoid` to produce a `ring_hom`.

## Direct sums of subobjects

Additionally, this module provides helper functions to construct `gsemiring` and `gcomm_semiring`
instances for:

* `A : ι → submonoid S`:
  `direct_sum.gsemiring.of_add_submonoids`, `direct_sum.gcomm_semiring.of_add_submonoids`.
* `A : ι → subgroup S`:
  `direct_sum.gsemiring.of_add_subgroups`, `direct_sum.gcomm_semiring.of_add_subgroups`.
* `A : ι → submodule S`:
  `direct_sum.gsemiring.of_submodules`, `direct_sum.gcomm_semiring.of_submodules`.

If `complete_lattice.independent (set.range A)`, these provide a gradation of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

graded ring, filtered ring, direct sum, add_submonoid
-/

variable {ι : Type _} [DecidableEq ι]

namespace DirectSum

open DirectSum

/-! ### Typeclasses -/

section Defs

variable (A : ι → Type _)

/-- A graded version of `non_unital_non_assoc_semiring`. -/
class GnonUnitalNonAssocSemiring [Add ι] [∀ i, AddCommMonoid (A i)] extends
  GradedMonoid.GMul A where
  mul_zero : ∀ {i j} (a : A i), mul a (0 : A j) = 0
  zero_mul : ∀ {i j} (b : A j), mul (0 : A i) b = 0
  mul_add : ∀ {i j} (a : A i) (b c : A j), mul a (b + c) = mul a b + mul a c
  add_mul : ∀ {i j} (a b : A i) (c : A j), mul (a + b) c = mul a c + mul b c
#align direct_sum.gnon_unital_non_assoc_semiring DirectSum.GnonUnitalNonAssocSemiring

end Defs

section Defs

variable (A : ι → Type _)

/-- A graded version of `semiring`. -/
class Gsemiring [AddMonoid ι] [∀ i, AddCommMonoid (A i)] extends GnonUnitalNonAssocSemiring A,
  GradedMonoid.GMonoid A where
  natCast : ℕ → A 0
  natCast_zero : nat_cast 0 = 0
  natCast_succ : ∀ n : ℕ, nat_cast (n + 1) = nat_cast n + GradedMonoid.GOne.one
#align direct_sum.gsemiring DirectSum.Gsemiring

/-- A graded version of `comm_semiring`. -/
class GcommSemiring [AddCommMonoid ι] [∀ i, AddCommMonoid (A i)] extends Gsemiring A,
  GradedMonoid.GCommMonoid A
#align direct_sum.gcomm_semiring DirectSum.GcommSemiring

/-- A graded version of `ring`. -/
class Gring [AddMonoid ι] [∀ i, AddCommGroup (A i)] extends Gsemiring A where
  intCast : ℤ → A 0
  intCast_ofNat : ∀ n : ℕ, int_cast n = nat_cast n
  intCast_negSucc : ∀ n : ℕ, int_cast (-(n + 1 : ℕ)) = -nat_cast (n + 1 : ℕ)
#align direct_sum.gring DirectSum.Gring

/-- A graded version of `comm_ring`. -/
class GcommRing [AddCommMonoid ι] [∀ i, AddCommGroup (A i)] extends Gring A, GcommSemiring A
#align direct_sum.gcomm_ring DirectSum.GcommRing

end Defs

theorem of_eq_of_gradedMonoid_eq {A : ι → Type _} [∀ i : ι, AddCommMonoid (A i)] {i j : ι} {a : A i}
    {b : A j} (h : GradedMonoid.mk i a = GradedMonoid.mk j b) :
    DirectSum.of A i a = DirectSum.of A j b :=
  Dfinsupp.single_eq_of_sigma_eq h
#align direct_sum.of_eq_of_graded_monoid_eq DirectSum.of_eq_of_gradedMonoid_eq

variable (A : ι → Type _)

/-! ### Instances for `⨁ i, A i` -/

section One

variable [Zero ι] [GradedMonoid.GOne A] [∀ i, AddCommMonoid (A i)]

instance : One (⨁ i, A i) where one := DirectSum.of (fun i => A i) 0 GradedMonoid.GOne.one

end One

section Mul

variable [Add ι] [∀ i, AddCommMonoid (A i)] [GnonUnitalNonAssocSemiring A]

open AddMonoidHom (flip_apply coe_comp compHom_apply_apply)

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps]
def gmulHom {i j} : A i →+ A j →+ A (i + j)
    where
  toFun a :=
    { toFun := fun b => GradedMonoid.GMul.mul a b
      map_zero' := GnonUnitalNonAssocSemiring.mul_zero _
      map_add' := GnonUnitalNonAssocSemiring.mul_add _ }
  map_zero' := AddMonoidHom.ext fun a => GnonUnitalNonAssocSemiring.zero_mul a
  map_add' a₁ a₂ := AddMonoidHom.ext fun b => GnonUnitalNonAssocSemiring.add_mul _ _ _
#align direct_sum.gmul_hom DirectSum.gmulHom

/-- The multiplication from the `has_mul` instance, as a bundled homomorphism. -/
def mulHom : (⨁ i, A i) →+ (⨁ i, A i) →+ ⨁ i, A i :=
  DirectSum.toAddMonoid fun i =>
    AddMonoidHom.flip <|
      DirectSum.toAddMonoid fun j =>
        AddMonoidHom.flip <| (DirectSum.of A _).compHom.comp <| gmulHom A
#align direct_sum.mul_hom DirectSum.mulHom

instance : NonUnitalNonAssocSemiring (⨁ i, A i) :=
  { DirectSum.addCommMonoid _ _ with
    mul := fun a b => mulHom A a b
    zero := 0
    add := (· + ·)
    zero_mul := fun a => by simp only [AddMonoidHom.map_zero, AddMonoidHom.zero_apply]
    mul_zero := fun a => by simp only [AddMonoidHom.map_zero]
    left_distrib := fun a b c => by simp only [AddMonoidHom.map_add]
    right_distrib := fun a b c => by simp only [AddMonoidHom.map_add, AddMonoidHom.add_apply] }

variable {A}

theorem mulHom_of_of {i j} (a : A i) (b : A j) :
    mulHom A (of _ i a) (of _ j b) = of _ (i + j) (GradedMonoid.GMul.mul a b) :=
  by
  unfold MulHom
  rw [to_add_monoid_of, flip_apply, to_add_monoid_of, flip_apply, coe_comp, Function.comp_apply,
    comp_hom_apply_apply, coe_comp, Function.comp_apply, gmul_hom_apply_apply]
#align direct_sum.mul_hom_of_of DirectSum.mulHom_of_of

theorem of_mul_of {i j} (a : A i) (b : A j) :
    of _ i a * of _ j b = of _ (i + j) (GradedMonoid.GMul.mul a b) :=
  mulHom_of_of a b
#align direct_sum.of_mul_of DirectSum.of_mul_of

end Mul

section Semiring

variable [∀ i, AddCommMonoid (A i)] [AddMonoid ι] [Gsemiring A]

open AddMonoidHom (flipHom coe_comp compHom_apply_apply flip_apply flipHom_apply)

private theorem one_mul (x : ⨁ i, A i) : 1 * x = x :=
  by
  suffices mulHom A 1 = AddMonoidHom.id (⨁ i, A i) from AddMonoidHom.congr_fun this x
  apply add_hom_ext; intro i xi
  unfold One.one
  rw [mul_hom_of_of]
  exact of_eq_of_graded_monoid_eq (one_mul <| GradedMonoid.mk i xi)
#align direct_sum.one_mul direct_sum.one_mul

private theorem mul_one (x : ⨁ i, A i) : x * 1 = x :=
  by
  suffices (mulHom A).flip 1 = AddMonoidHom.id (⨁ i, A i) from AddMonoidHom.congr_fun this x
  apply add_hom_ext; intro i xi
  unfold One.one
  rw [flip_apply, mul_hom_of_of]
  exact of_eq_of_graded_monoid_eq (mul_one <| GradedMonoid.mk i xi)
#align direct_sum.mul_one direct_sum.mul_one

private theorem mul_assoc (a b c : ⨁ i, A i) : a * b * c = a * (b * c) :=
  by
  suffices
    (-- `λ a b c, a * b * c` as a bundled hom
              mulHom
              A).compHom.comp
        (mulHom A) =
      (AddMonoidHom.compHom flipHom <|
          (-- `λ a b c, a * (b * c)` as a bundled hom
                    mulHom
                    A).flip.compHom.comp
            (mulHom A)).flip
    from AddMonoidHom.congr_fun (AddMonoidHom.congr_fun (AddMonoidHom.congr_fun this a) b) c
  ext (ai ax bi bx ci cx) : 6
  dsimp only [coe_comp, Function.comp_apply, comp_hom_apply_apply, flip_apply, flip_hom_apply]
  rw [mul_hom_of_of, mul_hom_of_of, mul_hom_of_of, mul_hom_of_of]
  exact of_eq_of_graded_monoid_eq (mul_assoc (GradedMonoid.mk ai ax) ⟨bi, bx⟩ ⟨ci, cx⟩)
#align direct_sum.mul_assoc direct_sum.mul_assoc

/-- The `semiring` structure derived from `gsemiring A`. -/
instance semiring : Semiring (⨁ i, A i) :=
  { DirectSum.nonUnitalNonAssocSemiring _ with
    one := 1
    mul := (· * ·)
    zero := 0
    add := (· + ·)
    one_mul := one_mul A
    mul_one := mul_one A
    mul_assoc := mul_assoc A
    natCast := fun n => of _ _ (Gsemiring.natCast n)
    natCast_zero := by rw [gsemiring.nat_cast_zero, map_zero]
    natCast_succ := fun n => by
      rw [gsemiring.nat_cast_succ, map_add]
      rfl }
#align direct_sum.semiring DirectSum.semiring

theorem of_pow {i} (a : A i) (n : ℕ) :
    of _ i a ^ n = of _ (n • i) (GradedMonoid.GMonoid.gnpow _ a) :=
  by
  induction' n with n
  · exact of_eq_of_graded_monoid_eq (pow_zero <| GradedMonoid.mk _ a).symm
  · rw [pow_succ, n_ih, of_mul_of]
    exact of_eq_of_graded_monoid_eq (pow_succ (GradedMonoid.mk _ a) n).symm
#align direct_sum.of_pow DirectSum.of_pow

theorem of_list_dProd {α} (l : List α) (fι : α → ι) (fA : ∀ a, A (fι a)) :
    of A _ (l.dProd fι fA) = (l.map fun a => of A (fι a) (fA a)).Prod :=
  by
  induction l
  · simp only [List.map_nil, List.prod_nil, List.dProd_nil]
    rfl
  · simp only [List.map_cons, List.prod_cons, List.dProd_cons, ← l_ih, DirectSum.of_mul_of]
    rfl
#align direct_sum.of_list_dprod DirectSum.of_list_dProd

theorem list_prod_ofFn_of_eq_dProd (n : ℕ) (fι : Fin n → ι) (fA : ∀ a, A (fι a)) :
    (List.ofFn fun a => of A (fι a) (fA a)).Prod = of A _ ((List.finRange n).dProd fι fA) := by
  rw [List.ofFn_eq_map, of_list_dprod]
#align direct_sum.list_prod_of_fn_of_eq_dprod DirectSum.list_prod_ofFn_of_eq_dProd

open BigOperators

theorem mul_eq_dfinsupp_sum [∀ (i : ι) (x : A i), Decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
    a * a' = a.Sum fun i ai => a'.Sum fun j aj => DirectSum.of _ _ <| GradedMonoid.GMul.mul ai aj :=
  by
  change MulHom _ a a' = _
  simpa only [MulHom, to_add_monoid, Dfinsupp.liftAddHom_apply, Dfinsupp.sumAddHom_apply,
    AddMonoidHom.dfinsupp_sum_apply, flip_apply, AddMonoidHom.dfinsupp_sumAddHom_apply]
#align direct_sum.mul_eq_dfinsupp_sum DirectSum.mul_eq_dfinsupp_sum

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A heavily unfolded version of the definition of multiplication -/
theorem mul_eq_sum_support_ghas_mul [∀ (i : ι) (x : A i), Decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
    a * a' =
      ∑ ij in Dfinsupp.support a ×ˢ Dfinsupp.support a',
        DirectSum.of _ _ (GradedMonoid.GMul.mul (a ij.fst) (a' ij.snd)) :=
  by simp only [mul_eq_dfinsupp_sum, Dfinsupp.sum, Finset.sum_product]
#align direct_sum.mul_eq_sum_support_ghas_mul DirectSum.mul_eq_sum_support_ghas_mul

end Semiring

section CommSemiring

variable [∀ i, AddCommMonoid (A i)] [AddCommMonoid ι] [GcommSemiring A]

private theorem mul_comm (a b : ⨁ i, A i) : a * b = b * a :=
  by
  suffices mulHom A = (mulHom A).flip from AddMonoidHom.congr_fun (AddMonoidHom.congr_fun this a) b
  apply add_hom_ext; intro ai ax; apply add_hom_ext; intro bi bx
  rw [AddMonoidHom.flip_apply, mul_hom_of_of, mul_hom_of_of]
  exact of_eq_of_graded_monoid_eq (gcomm_semiring.mul_comm ⟨ai, ax⟩ ⟨bi, bx⟩)
#align direct_sum.mul_comm direct_sum.mul_comm

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance commSemiring : CommSemiring (⨁ i, A i) :=
  { DirectSum.semiring _ with
    one := 1
    mul := (· * ·)
    zero := 0
    add := (· + ·)
    mul_comm := mul_comm A }
#align direct_sum.comm_semiring DirectSum.commSemiring

end CommSemiring

section NonUnitalNonAssocRing

variable [∀ i, AddCommGroup (A i)] [Add ι] [GnonUnitalNonAssocSemiring A]

/-- The `ring` derived from `gsemiring A`. -/
instance nonAssocRing : NonUnitalNonAssocRing (⨁ i, A i) :=
  { DirectSum.nonUnitalNonAssocSemiring _,
    DirectSum.addCommGroup _ with
    mul := (· * ·)
    zero := 0
    add := (· + ·)
    neg := Neg.neg }
#align direct_sum.non_assoc_ring DirectSum.nonAssocRing

end NonUnitalNonAssocRing

section Ring

variable [∀ i, AddCommGroup (A i)] [AddMonoid ι] [Gring A]

/-- The `ring` derived from `gsemiring A`. -/
instance ring : Ring (⨁ i, A i) :=
  { DirectSum.semiring _,
    DirectSum.addCommGroup _ with
    one := 1
    mul := (· * ·)
    zero := 0
    add := (· + ·)
    neg := Neg.neg
    intCast := fun z => of _ _ (Gring.intCast z)
    intCast_ofNat := fun z => congr_arg _ <| Gring.intCast_of_nat _
    intCast_negSucc := fun z =>
      (congr_arg _ <| Gring.intCast_neg_succ_of_nat _).trans (map_neg _ _) }
#align direct_sum.ring DirectSum.ring

end Ring

section CommRing

variable [∀ i, AddCommGroup (A i)] [AddCommMonoid ι] [GcommRing A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance commRing : CommRing (⨁ i, A i) :=
  { DirectSum.ring _,
    DirectSum.commSemiring _ with
    one := 1
    mul := (· * ·)
    zero := 0
    add := (· + ·)
    neg := Neg.neg }
#align direct_sum.comm_ring DirectSum.commRing

end CommRing

/-! ### Instances for `A 0`

The various `g*` instances are enough to promote the `add_comm_monoid (A 0)` structure to various
types of multiplicative structure.
-/

section GradeZero

section One

variable [Zero ι] [GradedMonoid.GOne A] [∀ i, AddCommMonoid (A i)]

@[simp]
theorem of_zero_one : of _ 0 (1 : A 0) = 1 :=
  rfl
#align direct_sum.of_zero_one DirectSum.of_zero_one

end One

section Mul

variable [AddZeroClass ι] [∀ i, AddCommMonoid (A i)] [GnonUnitalNonAssocSemiring A]

@[simp]
theorem of_zero_smul {i} (a : A 0) (b : A i) : of _ _ (a • b) = of _ _ a * of _ _ b :=
  (of_eq_of_gradedMonoid_eq (GradedMonoid.mk_zero_smul a b)).trans (of_mul_of _ _).symm
#align direct_sum.of_zero_smul DirectSum.of_zero_smul

@[simp]
theorem of_zero_mul (a b : A 0) : of _ 0 (a * b) = of _ 0 a * of _ 0 b :=
  of_zero_smul A a b
#align direct_sum.of_zero_mul DirectSum.of_zero_mul

instance GradeZero.nonUnitalNonAssocSemiring : NonUnitalNonAssocSemiring (A 0) :=
  Function.Injective.nonUnitalNonAssocSemiring (of A 0) Dfinsupp.single_injective (of A 0).map_zero
    (of A 0).map_add (of_zero_mul A) fun x n => Dfinsupp.single_smul n x
#align direct_sum.grade_zero.non_unital_non_assoc_semiring DirectSum.GradeZero.nonUnitalNonAssocSemiring

instance GradeZero.smulWithZero (i : ι) : SMulWithZero (A 0) (A i) :=
  by
  letI := SMulWithZero.compHom (⨁ i, A i) (of A 0).toZeroHom
  refine' dfinsupp.single_injective.smul_with_zero (of A i).toZeroHom (of_zero_smul A)
#align direct_sum.grade_zero.smul_with_zero DirectSum.GradeZero.smulWithZero

end Mul

section Semiring

variable [∀ i, AddCommMonoid (A i)] [AddMonoid ι] [Gsemiring A]

@[simp]
theorem of_zero_pow (a : A 0) : ∀ n : ℕ, of _ 0 (a ^ n) = of _ 0 a ^ n
  | 0 => by rw [pow_zero, pow_zero, DirectSum.of_zero_one]
  | n + 1 => by rw [pow_succ, pow_succ, of_zero_mul, of_zero_pow]
#align direct_sum.of_zero_pow DirectSum.of_zero_pow

instance : NatCast (A 0) :=
  ⟨Gsemiring.natCast⟩

@[simp]
theorem of_nat_cast (n : ℕ) : of A 0 n = n :=
  rfl
#align direct_sum.of_nat_cast DirectSum.of_nat_cast

/-- The `semiring` structure derived from `gsemiring A`. -/
instance GradeZero.semiring : Semiring (A 0) :=
  Function.Injective.semiring (of A 0) Dfinsupp.single_injective (of A 0).map_zero (of_zero_one A)
    (of A 0).map_add (of_zero_mul A) (of A 0).map_nsmul (fun x n => of_zero_pow _ _ _)
    (of_nat_cast A)
#align direct_sum.grade_zero.semiring DirectSum.GradeZero.semiring

/-- `of A 0` is a `ring_hom`, using the `direct_sum.grade_zero.semiring` structure. -/
def ofZeroRingHom : A 0 →+* ⨁ i, A i :=
  { of _ 0 with
    map_one' := of_zero_one A
    map_mul' := of_zero_mul A }
#align direct_sum.of_zero_ring_hom DirectSum.ofZeroRingHom

/-- Each grade `A i` derives a `A 0`-module structure from `gsemiring A`. Note that this results
in an overall `module (A 0) (⨁ i, A i)` structure via `direct_sum.module`.
-/
instance GradeZero.module {i} : Module (A 0) (A i) :=
  letI := Module.compHom (⨁ i, A i) (of_zero_ring_hom A)
  dfinsupp.single_injective.module (A 0) (of A i) fun a => of_zero_smul A a
#align direct_sum.grade_zero.module DirectSum.GradeZero.module

end Semiring

section CommSemiring

variable [∀ i, AddCommMonoid (A i)] [AddCommMonoid ι] [GcommSemiring A]

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance GradeZero.commSemiring : CommSemiring (A 0) :=
  Function.Injective.commSemiring (of A 0) Dfinsupp.single_injective (of A 0).map_zero
    (of_zero_one A) (of A 0).map_add (of_zero_mul A) (fun x n => Dfinsupp.single_smul n x)
    (fun x n => of_zero_pow _ _ _) (of_nat_cast A)
#align direct_sum.grade_zero.comm_semiring DirectSum.GradeZero.commSemiring

end CommSemiring

section Ring

variable [∀ i, AddCommGroup (A i)] [AddZeroClass ι] [GnonUnitalNonAssocSemiring A]

/-- The `non_unital_non_assoc_ring` derived from `gnon_unital_non_assoc_semiring A`. -/
instance GradeZero.nonUnitalNonAssocRing : NonUnitalNonAssocRing (A 0) :=
  Function.Injective.nonUnitalNonAssocRing (of A 0) Dfinsupp.single_injective (of A 0).map_zero
    (of A 0).map_add (of_zero_mul A) (of A 0).map_neg (of A 0).map_sub
    (fun x n =>
      letI : ∀ i, DistribMulAction ℕ (A i) := fun i => inferInstance
      Dfinsupp.single_smul n x)
    fun x n =>
    letI : ∀ i, DistribMulAction ℤ (A i) := fun i => inferInstance
    Dfinsupp.single_smul n x
#align direct_sum.grade_zero.non_unital_non_assoc_ring DirectSum.GradeZero.nonUnitalNonAssocRing

end Ring

section Ring

variable [∀ i, AddCommGroup (A i)] [AddMonoid ι] [Gring A]

instance : IntCast (A 0) :=
  ⟨Gring.intCast⟩

@[simp]
theorem of_int_cast (n : ℤ) : of A 0 n = n :=
  rfl
#align direct_sum.of_int_cast DirectSum.of_int_cast

/-- The `ring` derived from `gsemiring A`. -/
instance GradeZero.ring : Ring (A 0) :=
  Function.Injective.ring (of A 0) Dfinsupp.single_injective (of A 0).map_zero (of_zero_one A)
    (of A 0).map_add (of_zero_mul A) (of A 0).map_neg (of A 0).map_sub
    (fun x n =>
      letI : ∀ i, DistribMulAction ℕ (A i) := fun i => inferInstance
      Dfinsupp.single_smul n x)
    (fun x n =>
      letI : ∀ i, DistribMulAction ℤ (A i) := fun i => inferInstance
      Dfinsupp.single_smul n x)
    (fun x n => of_zero_pow _ _ _) (of_nat_cast A) (of_int_cast A)
#align direct_sum.grade_zero.ring DirectSum.GradeZero.ring

end Ring

section CommRing

variable [∀ i, AddCommGroup (A i)] [AddCommMonoid ι] [GcommRing A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance GradeZero.commRing : CommRing (A 0) :=
  Function.Injective.commRing (of A 0) Dfinsupp.single_injective (of A 0).map_zero (of_zero_one A)
    (of A 0).map_add (of_zero_mul A) (of A 0).map_neg (of A 0).map_sub
    (fun x n =>
      letI : ∀ i, DistribMulAction ℕ (A i) := fun i => inferInstance
      Dfinsupp.single_smul n x)
    (fun x n =>
      letI : ∀ i, DistribMulAction ℤ (A i) := fun i => inferInstance
      Dfinsupp.single_smul n x)
    (fun x n => of_zero_pow _ _ _) (of_nat_cast A) (of_int_cast A)
#align direct_sum.grade_zero.comm_ring DirectSum.GradeZero.commRing

end CommRing

end GradeZero

section ToSemiring

variable {R : Type _} [∀ i, AddCommMonoid (A i)] [AddMonoid ι] [Gsemiring A] [Semiring R]

variable {A}

/-- If two ring homomorphisms from `⨁ i, A i` are equal on each `of A i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem ringHom_ext' ⦃F G : (⨁ i, A i) →+* R⦄
    (h : ∀ i, (↑F : _ →+ R).comp (of A i) = (↑G : _ →+ R).comp (of A i)) : F = G :=
  RingHom.coe_addMonoidHom_injective <| DirectSum.addHom_ext' h
#align direct_sum.ring_hom_ext' DirectSum.ringHom_ext'

/-- Two `ring_hom`s out of a direct sum are equal if they agree on the generators. -/
theorem ringHom_ext ⦃f g : (⨁ i, A i) →+* R⦄ (h : ∀ i x, f (of A i x) = g (of A i x)) : f = g :=
  ringHom_ext' fun i => AddMonoidHom.ext <| h i
#align direct_sum.ring_hom_ext DirectSum.ringHom_ext

/-- A family of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
describes a `ring_hom`s on `⨁ i, A i`. This is a stronger version of `direct_sum.to_monoid`.

Of particular interest is the case when `A i` are bundled subojects, `f` is the family of
coercions such as `add_submonoid.subtype (A i)`, and the `[gsemiring A]` structure originates from
`direct_sum.gsemiring.of_add_submonoids`, in which case the proofs about `ghas_one` and `ghas_mul`
can be discharged by `rfl`. -/
@[simps]
def toSemiring (f : ∀ i, A i →+ R) (hone : f _ GradedMonoid.GOne.one = 1)
    (hmul : ∀ {i j} (ai : A i) (aj : A j), f _ (GradedMonoid.GMul.mul ai aj) = f _ ai * f _ aj) :
    (⨁ i, A i) →+* R :=
  { toAddMonoid f with
    toFun := toAddMonoid f
    map_one' := by
      change (to_add_monoid f) (of _ 0 _) = 1
      rw [to_add_monoid_of]
      exact hone
    map_mul' := by
      rw [(to_add_monoid f).map_mul_iff]
      ext (xi xv yi yv) : 4
      show
        to_add_monoid f (of A xi xv * of A yi yv) =
          to_add_monoid f (of A xi xv) * to_add_monoid f (of A yi yv)
      rw [of_mul_of, to_add_monoid_of, to_add_monoid_of, to_add_monoid_of]
      exact hmul _ _ }
#align direct_sum.to_semiring DirectSum.toSemiring

@[simp]
theorem toSemiring_of (f : ∀ i, A i →+ R) (hone hmul) (i : ι) (x : A i) :
    toSemiring f hone hmul (of _ i x) = f _ x :=
  toAddMonoid_of f i x
#align direct_sum.to_semiring_of DirectSum.toSemiring_of

@[simp]
theorem toSemiring_coe_addMonoidHom (f : ∀ i, A i →+ R) (hone hmul) :
    (toSemiring f hone hmul : (⨁ i, A i) →+ R) = toAddMonoid f :=
  rfl
#align direct_sum.to_semiring_coe_add_monoid_hom DirectSum.toSemiring_coe_addMonoidHom

/-- Families of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
are isomorphic to `ring_hom`s on `⨁ i, A i`. This is a stronger version of `dfinsupp.lift_add_hom`.
-/
@[simps]
def liftRingHom :
    { f : ∀ {i}, A i →+ R //
        f GradedMonoid.GOne.one = 1 ∧
          ∀ {i j} (ai : A i) (aj : A j), f (GradedMonoid.GMul.mul ai aj) = f ai * f aj } ≃
      ((⨁ i, A i) →+* R)
    where
  toFun f := toSemiring (fun _ => f.1) f.2.1 fun _ _ => f.2.2
  invFun F :=
    ⟨fun i => (F : (⨁ i, A i) →+ R).comp (of _ i),
      by
      simp only [AddMonoidHom.comp_apply, [anonymous]]
      rw [← F.map_one]
      rfl, fun i j ai aj =>
      by
      simp only [AddMonoidHom.comp_apply, [anonymous]]
      rw [← F.map_mul, of_mul_of]⟩
  left_inv f := by
    ext (xi xv)
    exact to_add_monoid_of (fun _ => f.1) xi xv
  right_inv F := by
    apply RingHom.coe_addMonoidHom_injective
    ext (xi xv)
    simp only [RingHom.coe_addMonoidHom_mk, DirectSum.toAddMonoid_of, AddMonoidHom.mk_coe,
      AddMonoidHom.comp_apply, to_semiring_coe_add_monoid_hom]
#align direct_sum.lift_ring_hom DirectSum.liftRingHom

end ToSemiring

end DirectSum

/-! ### Concrete instances -/

section Uniform

variable (ι)

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance NonUnitalNonAssocSemiring.directSumGnonUnitalNonAssocSemiring {R : Type _} [AddMonoid ι]
    [NonUnitalNonAssocSemiring R] : DirectSum.GnonUnitalNonAssocSemiring fun i : ι => R :=
  { Mul.gMul ι with
    mul_zero := fun i j => MulZeroClass.mul_zero
    zero_mul := fun i j => MulZeroClass.zero_mul
    mul_add := fun i j => mul_add
    add_mul := fun i j => add_mul }
#align non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring NonUnitalNonAssocSemiring.directSumGnonUnitalNonAssocSemiring

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance Semiring.directSumGsemiring {R : Type _} [AddMonoid ι] [Semiring R] :
    DirectSum.Gsemiring fun i : ι => R :=
  { NonUnitalNonAssocSemiring.directSumGnonUnitalNonAssocSemiring ι,
    Monoid.gMonoid ι with
    natCast := fun n => n
    natCast_zero := Nat.cast_zero
    natCast_succ := Nat.cast_succ }
#align semiring.direct_sum_gsemiring Semiring.directSumGsemiring

open DirectSum

-- To check `has_mul.ghas_mul_mul` matches
example {R : Type _} [AddMonoid ι] [Semiring R] (i j : ι) (a b : R) :
    (DirectSum.of _ i a * DirectSum.of _ j b : ⨁ i, R) = DirectSum.of _ (i + j) (a * b) := by
  rw [DirectSum.of_mul_of, Mul.gMul_mul]

/-- A direct sum of copies of a `comm_semiring` inherits the commutative multiplication structure.
-/
instance CommSemiring.directSumGcommSemiring {R : Type _} [AddCommMonoid ι] [CommSemiring R] :
    DirectSum.GcommSemiring fun i : ι => R :=
  { CommMonoid.gCommMonoid ι, Semiring.directSumGsemiring ι with }
#align comm_semiring.direct_sum_gcomm_semiring CommSemiring.directSumGcommSemiring

end Uniform


/-
Copyright (c) 2023 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module topology.instances.triv_sq_zero_ext
! leanprover-community/mathlib commit b8d2eaa69d69ce8f03179a5cda774fc0cde984e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.TrivSqZeroExt
import Mathbin.Topology.Algebra.InfiniteSum.Basic
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Topology on `triv_sq_zero_ext R M`

The type `triv_sq_zero_ext R M` inherits the topology from `R × M`.

Note that this is not the topology induced by the seminorm on the dual numbers suggested by
[this Math.SE answer](https://math.stackexchange.com/a/1056378/1896), which instead induces
the topology pulled back through the projection map `triv_sq_zero_ext.fst : tsze R M → R`.
Obviously, that topology is not Hausdorff and using it would result in `exp` converging to more than
one value.

## Main results

* `triv_sq_zero_ext.topological_ring`: the ring operations are continuous

-/

variable {α S R M : Type _}

-- mathport name: exprtsze
local notation "tsze" => TrivSqZeroExt

namespace TrivSqZeroExt

variable [TopologicalSpace R] [TopologicalSpace M]

instance : TopologicalSpace (tsze R M) :=
  TopologicalSpace.induced fst ‹_› ⊓ TopologicalSpace.induced snd ‹_›

instance [T2Space R] [T2Space M] : T2Space (tsze R M) :=
  Prod.t2Space

theorem nhds_def (x : tsze R M) : nhds x = (nhds x.fst).Prod (nhds x.snd) := by
  cases x <;> exact nhds_prod_eq
#align triv_sq_zero_ext.nhds_def TrivSqZeroExt.nhds_def

theorem nhds_inl [Zero M] (x : R) : nhds (inl x : tsze R M) = (nhds x).Prod (nhds 0) :=
  nhds_def _
#align triv_sq_zero_ext.nhds_inl TrivSqZeroExt.nhds_inl

theorem nhds_inr [Zero R] (m : M) : nhds (inr m : tsze R M) = (nhds 0).Prod (nhds m) :=
  nhds_def _
#align triv_sq_zero_ext.nhds_inr TrivSqZeroExt.nhds_inr

theorem continuous_fst : Continuous (fst : tsze R M → R) :=
  continuous_fst
#align triv_sq_zero_ext.continuous_fst TrivSqZeroExt.continuous_fst

theorem continuous_snd : Continuous (snd : tsze R M → M) :=
  continuous_snd
#align triv_sq_zero_ext.continuous_snd TrivSqZeroExt.continuous_snd

theorem continuous_inl [Zero M] : Continuous (inl : R → tsze R M) :=
  continuous_id.prod_mk continuous_const
#align triv_sq_zero_ext.continuous_inl TrivSqZeroExt.continuous_inl

theorem continuous_inr [Zero R] : Continuous (inr : M → tsze R M) :=
  continuous_const.prod_mk continuous_id
#align triv_sq_zero_ext.continuous_inr TrivSqZeroExt.continuous_inr

theorem embedding_inl [Zero M] : Embedding (inl : R → tsze R M) :=
  embedding_of_embedding_compose continuous_inl continuous_fst embedding_id
#align triv_sq_zero_ext.embedding_inl TrivSqZeroExt.embedding_inl

theorem embedding_inr [Zero R] : Embedding (inr : M → tsze R M) :=
  embedding_of_embedding_compose continuous_inr continuous_snd embedding_id
#align triv_sq_zero_ext.embedding_inr TrivSqZeroExt.embedding_inr

variable (R M)

/-- `triv_sq_zero_ext.fst` as a continuous linear map. -/
@[simps]
def fstClm [CommSemiring R] [AddCommMonoid M] [Module R M] : tsze R M →L[R] R :=
  { ContinuousLinearMap.fst R R M with toFun := fst }
#align triv_sq_zero_ext.fst_clm TrivSqZeroExt.fstClm

/-- `triv_sq_zero_ext.snd` as a continuous linear map. -/
@[simps]
def sndClm [CommSemiring R] [AddCommMonoid M] [Module R M] : tsze R M →L[R] M :=
  { ContinuousLinearMap.snd R R M with
    toFun := snd
    cont := continuous_snd }
#align triv_sq_zero_ext.snd_clm TrivSqZeroExt.sndClm

/-- `triv_sq_zero_ext.inl` as a continuous linear map. -/
@[simps]
def inlClm [CommSemiring R] [AddCommMonoid M] [Module R M] : R →L[R] tsze R M :=
  { ContinuousLinearMap.inl R R M with toFun := inl }
#align triv_sq_zero_ext.inl_clm TrivSqZeroExt.inlClm

/-- `triv_sq_zero_ext.inr` as a continuous linear map. -/
@[simps]
def inrClm [CommSemiring R] [AddCommMonoid M] [Module R M] : M →L[R] tsze R M :=
  { ContinuousLinearMap.inr R R M with toFun := inr }
#align triv_sq_zero_ext.inr_clm TrivSqZeroExt.inrClm

variable {R M}

instance [Add R] [Add M] [ContinuousAdd R] [ContinuousAdd M] : ContinuousAdd (tsze R M) :=
  Prod.has_continuous_add

instance [Mul R] [Add M] [SMul R M] [SMul Rᵐᵒᵖ M] [ContinuousMul R] [ContinuousSMul R M]
    [ContinuousSMul Rᵐᵒᵖ M] [ContinuousAdd M] : ContinuousMul (tsze R M) :=
  ⟨((continuous_fst.comp continuous_fst).mul (continuous_fst.comp continuous_snd)).prod_mk <|
      ((continuous_fst.comp continuous_fst).smul (continuous_snd.comp continuous_snd)).add
        ((MulOpposite.continuous_op.comp <| continuous_fst.comp <| continuous_snd).smul
          (continuous_snd.comp continuous_fst))⟩

instance [Neg R] [Neg M] [ContinuousNeg R] [ContinuousNeg M] : ContinuousNeg (tsze R M) :=
  Prod.has_continuous_neg

/-- This is not an instance due to complaints by the `fails_quickly` linter. At any rate, we only
really care about the `topological_ring` instance below. -/
theorem topologicalSemiring [Semiring R] [AddCommMonoid M] [Module R M] [Module Rᵐᵒᵖ M]
    [TopologicalSemiring R] [ContinuousAdd M] [ContinuousSMul R M]
    [ContinuousSMul Rᵐᵒᵖ
        M] :-- note: lean times out looking for the non_assoc_semiring instance without this hint
      @TopologicalSemiring
      (tsze R M) _ (NonAssocSemiring.toNonUnitalNonAssocSemiring _) :=
  { }
#align triv_sq_zero_ext.topological_semiring TrivSqZeroExt.topologicalSemiring

instance [Ring R] [AddCommGroup M] [Module R M] [Module Rᵐᵒᵖ M] [TopologicalRing R]
    [TopologicalAddGroup M] [ContinuousSMul R M] [ContinuousSMul Rᵐᵒᵖ M] :
    TopologicalRing (tsze R M) where

instance [SMul S R] [SMul S M] [ContinuousConstSMul S R] [ContinuousConstSMul S M] :
    ContinuousConstSMul S (tsze R M) :=
  Prod.continuousConstSMul

instance [TopologicalSpace S] [SMul S R] [SMul S M] [ContinuousSMul S R] [ContinuousSMul S M] :
    ContinuousSMul S (tsze R M) :=
  Prod.continuousSMul

variable (M)

theorem hasSum_inl [AddCommMonoid R] [AddCommMonoid M] {f : α → R} {a : R} (h : HasSum f a) :
    HasSum (fun x => inl (f x)) (inl a : tsze R M) :=
  h.map (⟨inl, inl_zero _, inl_add _⟩ : R →+ tsze R M) continuous_inl
#align triv_sq_zero_ext.has_sum_inl TrivSqZeroExt.hasSum_inl

theorem hasSum_inr [AddCommMonoid R] [AddCommMonoid M] {f : α → M} {a : M} (h : HasSum f a) :
    HasSum (fun x => inr (f x)) (inr a : tsze R M) :=
  h.map (⟨inr, inr_zero _, inr_add _⟩ : M →+ tsze R M) continuous_inr
#align triv_sq_zero_ext.has_sum_inr TrivSqZeroExt.hasSum_inr

theorem hasSum_fst [AddCommMonoid R] [AddCommMonoid M] {f : α → tsze R M} {a : tsze R M}
    (h : HasSum f a) : HasSum (fun x => fst (f x)) (fst a) :=
  h.map (⟨fst, fst_zero, fst_add⟩ : tsze R M →+ R) continuous_fst
#align triv_sq_zero_ext.has_sum_fst TrivSqZeroExt.hasSum_fst

theorem hasSum_snd [AddCommMonoid R] [AddCommMonoid M] {f : α → tsze R M} {a : tsze R M}
    (h : HasSum f a) : HasSum (fun x => snd (f x)) (snd a) :=
  h.map (⟨snd, snd_zero, snd_add⟩ : tsze R M →+ M) continuous_snd
#align triv_sq_zero_ext.has_sum_snd TrivSqZeroExt.hasSum_snd

end TrivSqZeroExt


-- Copyright 2022-2023 VMware, Inc.
-- SPDX-License-Identifier: BSD-2-Clause

import .linear

variables {a: Type} [ordered_add_comm_group a].

def positive (s: stream a) := 0 <= s.
def stream_monotone (s: stream a) := ∀ t, s t ≤ s (t+1).
def is_positive {b: Type} [ordered_add_comm_group b]
  (f: stream a → stream b) := ∀ s, positive s → positive (f s).

-- TODO: could not get library monotone definition to work, possibly due to
-- partial_order.to_preorder?

-- set_option pp.notation false.
-- set_option pp.implicit true.

-- prove that [stream_monotone] can be rephrased in terms of order preservation
theorem stream_monotone_order (s: stream a) :
  stream_monotone s ↔ (∀ t1 t2, t1 ≤ t2 → s t1 ≤ s t2) :=
begin
  unfold stream_monotone, split; intro h; introv,
  { intros hle, have heq : t2 = t1 + (t2 - t1) := by omega,
    rw heq at *,
    generalize : (t2 - t1) = d,
    clear_dependent t2,
    induction d,
    { simp, },
    { transitivity s (t1 + d_n), assumption,
      apply h, }
   },
  { apply h, linarith, },
end

lemma integral_monotone (s: stream a) :
  positive s → stream_monotone (I s) :=
begin
  intros hp,
  intros t,
  repeat { rw integral_sum_vals },
  repeat { simp [sum_vals] },
  have h := hp (t + 1), simp at h,
  assumption,
end

lemma derivative_pos (s: stream a) :
  -- NOTE: paper is missing this, but it is also necessary (maybe they
  -- intend `s[-1] =0` in the definition of monotone)
  0 ≤ s 0 →
  stream_monotone s → positive (D s) :=
begin
  intros h0 hp, intros t; simp,
  unfold D delay; simp,
  split_ifs,
  { subst t, assumption },
  { have hle := hp (t - 1),
    have heq : t - 1 + 1 = t := by omega, rw heq at hle,
    assumption,
   },
end

lemma derivative_pos_counter_example :
  (∃ (x:a), x < 0) →
  ¬(∀ (s: stream a), stream_monotone s → positive (D s)) :=
begin
  intros h, cases h with x hneg,
  simp,
  -- pushing the negation through, we're going to prove
  -- ∃ (x : stream a), stream_monotone x ∧ ¬positive (D x)
  use (λ _n, x),
  split,
  { intros t, simp, },
  { unfold positive,
    rw stream_le_ext, simp,
    use 0, simp [D],
    apply not_le_of_gt, assumption,
   },
end


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

import algebraic_geometry.sheafed_space
import algebra.category.CommRing.limits
import algebra.category.CommRing.colimits
import algebraic_geometry.stalks
import ring_theory.ideal.basic

/-!
# The category of locally ringed spaces

We define (bundled) locally ringed spaces (as `SheafedSpace CommRing` along with the fact that the
stalks are local rings), and morphisms between these (morphisms in `SheafedSpace` with
`is_local_ring_hom` on the stalk maps).

## Future work
* Define the restriction along an open embedding
-/

universes v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

namespace algebraic_geometry

/-- A `LocallyRingedSpace` is a topological space equipped with a sheaf of commutative rings
such that all the stalks are local rings.

A morphism of locally ringed spaces is a morphism of ringed spaces
such that the morphims induced on stalks are local ring homomorphisms. -/
@[nolint has_inhabited_instance]
structure LocallyRingedSpace extends SheafedSpace CommRing :=
(local_ring : ∀ x, local_ring (presheaf.stalk x))

attribute [instance] LocallyRingedSpace.local_ring

namespace LocallyRingedSpace

variables (X : LocallyRingedSpace)

/-- The underlying topological space of a locally ringed space. -/
def to_Top : Top := X.1.carrier

instance : has_coe_to_sort LocallyRingedSpace :=
{ S := Type u,
  coe := λ X : LocallyRingedSpace, (X.to_Top : Type u), }

-- PROJECT: how about a typeclass "has_structure_sheaf" to mediate the 𝒪 notation, rather
-- than defining it over and over for PresheafedSpace, LRS, Scheme, etc.

/-- The structure sheaf of a locally ringed space. -/
def 𝒪 : sheaf CommRing X.to_Top := X.to_SheafedSpace.sheaf

/-- A morphism of locally ringed spaces is a morphism of ringed spaces
 such that the morphims induced on stalks are local ring homomorphisms. -/
def hom (X Y : LocallyRingedSpace) : Type* :=
{ f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace //
    ∀ x, is_local_ring_hom (PresheafedSpace.stalk_map f x) }

instance : quiver LocallyRingedSpace := ⟨hom⟩

@[ext] lemma hom_ext {X Y : LocallyRingedSpace} (f g : hom X Y) (w : f.1 = g.1) : f = g :=
subtype.eq w

/--
The stalk of a locally ringed space, just as a `CommRing`.
-/
-- TODO perhaps we should make a bundled `LocalRing` and return one here?
-- TODO define `sheaf.stalk` so we can write `X.𝒪.stalk` here?
noncomputable
def stalk (X : LocallyRingedSpace) (x : X) : CommRing := X.presheaf.stalk x

/--
A morphism of locally ringed spaces `f : X ⟶ Y` induces
a local ring homomorphism from `Y.stalk (f x)` to `X.stalk x` for any `x : X`.
-/
noncomputable
def stalk_map {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  Y.stalk (f.1.1 x) ⟶ X.stalk x :=
PresheafedSpace.stalk_map f.1 x

instance {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  is_local_ring_hom (stalk_map f x) := f.2 x

/-- The identity morphism on a locally ringed space. -/
@[simps]
def id (X : LocallyRingedSpace) : hom X X :=
⟨𝟙 _, λ x, by { erw PresheafedSpace.stalk_map.id, apply is_local_ring_hom_id, }⟩

instance (X : LocallyRingedSpace) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of locally ringed spaces. -/
@[simps]
def comp {X Y Z : LocallyRingedSpace} (f : hom X Y) (g : hom Y Z) : hom X Z :=
⟨f.val ≫ g.val, λ x,
begin
  erw PresheafedSpace.stalk_map.comp,
  exact @is_local_ring_hom_comp _ _ _ _ _ _ _ _ (f.2 _) (g.2 _),
end⟩

/-- The category of locally ringed spaces. -/
instance : category LocallyRingedSpace :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  comp_id' := by { intros, ext1, simp, },
  id_comp' := by { intros, ext1, simp, },
  assoc' := by { intros, ext1, simp, }, }.

/-- The forgetful functor from `LocallyRingedSpace` to `SheafedSpace CommRing`. -/
def forget_to_SheafedSpace : LocallyRingedSpace ⥤ SheafedSpace CommRing :=
{ obj := λ X, X.to_SheafedSpace,
  map := λ X Y f, f.1, }

instance : faithful forget_to_SheafedSpace := {}

-- PROJECT: once we have `PresheafedSpace.restrict_stalk_iso`
-- (that restriction doesn't change stalks) we can uncomment this.
/-
def restrict {U : Top} (X : LocallyRingedSpace)
  (f : U ⟶ X.to_Top) (h : open_embedding f) : LocallyRingedSpace :=
{ local_ring :=
  begin
    intro x,
    dsimp at *,
    -- We show that the stalk of the restriction is isomorphic to the original stalk,
    have := X.to_SheafedSpace.to_PresheafedSpace.restrict_stalk_iso f h x,
    -- and then transfer `local_ring` across the ring equivalence.
    apply (this.CommRing_iso_to_ring_equiv).local_ring, -- import data.equiv.transfer_instance
    apply X.local_ring,
  end,
  .. X.to_SheafedSpace.restrict _ f h }
-/

/--
The global sections, notated Gamma.
-/
def Γ : LocallyRingedSpaceᵒᵖ ⥤ CommRing :=
forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ

lemma Γ_def : Γ = forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ := rfl

@[simp] lemma Γ_obj (X : LocallyRingedSpaceᵒᵖ) : Γ.obj X = (unop X).presheaf.obj (op ⊤) := rfl

lemma Γ_obj_op (X : LocallyRingedSpace) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

@[simp] lemma Γ_map {X Y : LocallyRingedSpaceᵒᵖ} (f : X ⟶ Y) :
  Γ.map f = f.unop.1.c.app (op ⊤) ≫ (unop Y).presheaf.map (opens.le_map_top _ _).op := rfl

lemma Γ_map_op {X Y : LocallyRingedSpace} (f : X ⟶ Y) :
  Γ.map f.op = f.1.c.app (op ⊤) ≫ X.presheaf.map (opens.le_map_top _ _).op := rfl

end LocallyRingedSpace

end algebraic_geometry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer
-/
import algebraic_geometry.locally_ringed_space
import algebraic_geometry.structure_sheaf
import logic.equiv.transfer_instance
import ring_theory.localization.localization_localization
import topology.sheaves.sheaf_condition.sites
import topology.sheaves.functors
import algebra.module.localized_module

/-!
# $Spec$ as a functor to locally ringed spaces.

We define the functor $Spec$ from commutative rings to locally ringed spaces.

## Implementation notes

We define $Spec$ in three consecutive steps, each with more structure than the last:

1. `Spec.to_Top`, valued in the category of topological spaces,
2. `Spec.to_SheafedSpace`, valued in the category of sheafed spaces and
3. `Spec.to_LocallyRingedSpace`, valued in the category of locally ringed spaces.

Additionally, we provide `Spec.to_PresheafedSpace` as a composition of `Spec.to_SheafedSpace` with
a forgetful functor.

## Related results

The adjunction `Γ ⊣ Spec` is constructed in `algebraic_geometry/Gamma_Spec_adjunction.lean`.

-/

noncomputable theory
universes u v

namespace algebraic_geometry
open opposite
open category_theory
open structure_sheaf Spec (structure_sheaf)

/--
The spectrum of a commutative ring, as a topological space.
-/
def Spec.Top_obj (R : CommRing) : Top := Top.of (prime_spectrum R)

/--
The induced map of a ring homomorphism on the ring spectra, as a morphism of topological spaces.
-/
def Spec.Top_map {R S : CommRing} (f : R ⟶ S) :
  Spec.Top_obj S ⟶ Spec.Top_obj R :=
prime_spectrum.comap f

@[simp] lemma Spec.Top_map_id (R : CommRing) :
  Spec.Top_map (𝟙 R) = 𝟙 (Spec.Top_obj R) :=
prime_spectrum.comap_id

lemma Spec.Top_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.Top_map (f ≫ g) = Spec.Top_map g ≫ Spec.Top_map f :=
prime_spectrum.comap_comp _ _

/--
The spectrum, as a contravariant functor from commutative rings to topological spaces.
-/
@[simps] def Spec.to_Top : CommRingᵒᵖ ⥤ Top :=
{ obj := λ R, Spec.Top_obj (unop R),
  map := λ R S f, Spec.Top_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.Top_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.Top_map_comp] }

/--
The spectrum of a commutative ring, as a `SheafedSpace`.
-/
@[simps] def Spec.SheafedSpace_obj (R : CommRing) : SheafedSpace CommRing :=
{ carrier := Spec.Top_obj R,
  presheaf := (structure_sheaf R).1,
  is_sheaf := (structure_sheaf R).2 }

/--
The induced map of a ring homomorphism on the ring spectra, as a morphism of sheafed spaces.
-/
@[simps] def Spec.SheafedSpace_map {R S : CommRing.{u}} (f : R ⟶ S) :
  Spec.SheafedSpace_obj S ⟶ Spec.SheafedSpace_obj R :=
{ base := Spec.Top_map f,
  c :=
  { app := λ U, comap f (unop U) ((topological_space.opens.map (Spec.Top_map f)).obj (unop U))
      (λ p, id),
    naturality' := λ U V i, ring_hom.ext $ λ s, subtype.eq $ funext $ λ p, rfl } }

@[simp] lemma Spec.SheafedSpace_map_id {R : CommRing} :
  Spec.SheafedSpace_map (𝟙 R) = 𝟙 (Spec.SheafedSpace_obj R) :=
PresheafedSpace.ext _ _ (Spec.Top_map_id R) $ nat_trans.ext _ _ $ funext $ λ U,
begin
  dsimp,
  erw [PresheafedSpace.id_c_app, comap_id], swap,
  { rw [Spec.Top_map_id, topological_space.opens.map_id_obj_unop] },
  simpa [eq_to_hom_map],
end

lemma Spec.SheafedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.SheafedSpace_map (f ≫ g) = Spec.SheafedSpace_map g ≫ Spec.SheafedSpace_map f :=
PresheafedSpace.ext _ _ (Spec.Top_map_comp f g) $ nat_trans.ext _ _ $ funext $ λ U,
by { dsimp, rw category_theory.functor.map_id, rw category.comp_id, erw comap_comp f g, refl }

/--
Spec, as a contravariant functor from commutative rings to sheafed spaces.
-/
@[simps] def Spec.to_SheafedSpace : CommRingᵒᵖ ⥤ SheafedSpace CommRing :=
{ obj := λ R, Spec.SheafedSpace_obj (unop R),
  map := λ R S f, Spec.SheafedSpace_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.SheafedSpace_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.SheafedSpace_map_comp] }

/--
Spec, as a contravariant functor from commutative rings to presheafed spaces.
-/
def Spec.to_PresheafedSpace : CommRingᵒᵖ ⥤ PresheafedSpace.{u} CommRing.{u} :=
  Spec.to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace

@[simp] lemma Spec.to_PresheafedSpace_obj (R : CommRingᵒᵖ) :
  Spec.to_PresheafedSpace.obj R = (Spec.SheafedSpace_obj (unop R)).to_PresheafedSpace := rfl

lemma Spec.to_PresheafedSpace_obj_op (R : CommRing) :
  Spec.to_PresheafedSpace.obj (op R) = (Spec.SheafedSpace_obj R).to_PresheafedSpace := rfl

@[simp] lemma Spec.to_PresheafedSpace_map (R S : CommRingᵒᵖ) (f : R ⟶ S) :
  Spec.to_PresheafedSpace.map f = Spec.SheafedSpace_map f.unop := rfl

lemma Spec.to_PresheafedSpace_map_op (R S : CommRing) (f : R ⟶ S) :
  Spec.to_PresheafedSpace.map f.op = Spec.SheafedSpace_map f := rfl

lemma Spec.basic_open_hom_ext {X : RingedSpace} {R : CommRing} {α β : X ⟶ Spec.SheafedSpace_obj R}
  (w : α.base = β.base) (h : ∀ r : R, let U := prime_spectrum.basic_open r in
    (to_open R U ≫ α.c.app (op U)) ≫ X.presheaf.map (eq_to_hom (by rw w)) =
     to_open R U ≫ β.c.app (op U)) : α = β :=
begin
  ext1,
  { apply ((Top.sheaf.pushforward β.base).obj X.sheaf).hom_ext _
      prime_spectrum.is_basis_basic_opens,
    intro r,
    apply (structure_sheaf.to_basic_open_epi R r).1,
    simpa using h r },
  exact w,
end

/--
The spectrum of a commutative ring, as a `LocallyRingedSpace`.
-/
@[simps] def Spec.LocallyRingedSpace_obj (R : CommRing) : LocallyRingedSpace :=
{ local_ring := λ x, @@ring_equiv.local_ring _
    (show local_ring (localization.at_prime _), by apply_instance) _
    (iso.CommRing_iso_to_ring_equiv $ stalk_iso R x).symm,
  .. Spec.SheafedSpace_obj R }

@[elementwise]
lemma stalk_map_to_stalk {R S : CommRing} (f : R ⟶ S) (p : prime_spectrum S) :
  to_stalk R (prime_spectrum.comap f p) ≫
  PresheafedSpace.stalk_map (Spec.SheafedSpace_map f) p =
  f ≫ to_stalk S p :=
begin
  erw [← to_open_germ S ⊤ ⟨p, trivial⟩, ← to_open_germ R ⊤ ⟨prime_spectrum.comap f p, trivial⟩,
    category.assoc, PresheafedSpace.stalk_map_germ (Spec.SheafedSpace_map f) ⊤ ⟨p, trivial⟩,
    Spec.SheafedSpace_map_c_app, to_open_comp_comap_assoc],
  refl
end

/--
Under the isomorphisms `stalk_iso`, the map `stalk_map (Spec.SheafedSpace_map f) p` corresponds
to the induced local ring homomorphism `localization.local_ring_hom`.
-/
@[elementwise]
lemma local_ring_hom_comp_stalk_iso {R S : CommRing} (f : R ⟶ S) (p : prime_spectrum S) :
  (stalk_iso R (prime_spectrum.comap f p)).hom ≫
    @category_struct.comp _ _
      (CommRing.of (localization.at_prime (prime_spectrum.comap f p).as_ideal))
      (CommRing.of (localization.at_prime p.as_ideal)) _
      (localization.local_ring_hom (prime_spectrum.comap f p).as_ideal p.as_ideal f rfl)
      (stalk_iso S p).inv =
  PresheafedSpace.stalk_map (Spec.SheafedSpace_map f) p :=
(stalk_iso R (prime_spectrum.comap f p)).eq_inv_comp.mp $ (stalk_iso S p).comp_inv_eq.mpr $
localization.local_ring_hom_unique _ _ _ _ $ λ x, by
rw [stalk_iso_hom, stalk_iso_inv, comp_apply, comp_apply, localization_to_stalk_of,
  stalk_map_to_stalk_apply, stalk_to_fiber_ring_hom_to_stalk]

/--
The induced map of a ring homomorphism on the prime spectra, as a morphism of locally ringed spaces.
-/
@[simps] def Spec.LocallyRingedSpace_map {R S : CommRing} (f : R ⟶ S) :
  Spec.LocallyRingedSpace_obj S ⟶ Spec.LocallyRingedSpace_obj R :=
LocallyRingedSpace.hom.mk (Spec.SheafedSpace_map f) $ λ p, is_local_ring_hom.mk $ λ a ha,
begin
  -- Here, we are showing that the map on prime spectra induced by `f` is really a morphism of
  -- *locally* ringed spaces, i.e. that the induced map on the stalks is a local ring homomorphism.
  rw ← local_ring_hom_comp_stalk_iso_apply at ha,
  replace ha := (stalk_iso S p).hom.is_unit_map ha,
  rw iso.inv_hom_id_apply at ha,
  replace ha := is_local_ring_hom.map_nonunit _ ha,
  convert ring_hom.is_unit_map (stalk_iso R (prime_spectrum.comap f p)).inv ha,
  rw iso.hom_inv_id_apply
end

@[simp] lemma Spec.LocallyRingedSpace_map_id (R : CommRing) :
  Spec.LocallyRingedSpace_map (𝟙 R) = 𝟙 (Spec.LocallyRingedSpace_obj R) :=
LocallyRingedSpace.hom.ext _ _ $
  by { rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_id], refl }

lemma Spec.LocallyRingedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec.LocallyRingedSpace_map (f ≫ g) =
  Spec.LocallyRingedSpace_map g ≫ Spec.LocallyRingedSpace_map f :=
LocallyRingedSpace.hom.ext _ _ $
  by { rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_comp], refl }

/--
Spec, as a contravariant functor from commutative rings to locally ringed spaces.
-/
@[simps] def Spec.to_LocallyRingedSpace : CommRingᵒᵖ ⥤ LocallyRingedSpace :=
{ obj := λ R, Spec.LocallyRingedSpace_obj (unop R),
  map := λ R S f, Spec.LocallyRingedSpace_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec.LocallyRingedSpace_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec.LocallyRingedSpace_map_comp] }

section Spec_Γ
open algebraic_geometry.LocallyRingedSpace

/-- The counit morphism `R ⟶ Γ(Spec R)` given by `algebraic_geometry.structure_sheaf.to_open`.  -/
@[simps {rhs_md := tactic.transparency.semireducible}]
def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) :=
structure_sheaf.to_open R ⊤

instance is_iso_to_Spec_Γ (R : CommRing) : is_iso (to_Spec_Γ R) :=
by { cases R, apply structure_sheaf.is_iso_to_global }

@[reassoc]
lemma Spec_Γ_naturality {R S : CommRing} (f : R ⟶ S) :
  f ≫ to_Spec_Γ S = to_Spec_Γ R ≫ Γ.map (Spec.to_LocallyRingedSpace.map f.op).op :=
by { ext, symmetry, apply localization.local_ring_hom_to_map }

/-- The counit (`Spec_Γ_identity.inv.op`) of the adjunction `Γ ⊣ Spec` is an isomorphism. -/
@[simps hom_app inv_app] def Spec_Γ_identity : Spec.to_LocallyRingedSpace.right_op ⋙ Γ ≅ 𝟭 _ :=
iso.symm $ nat_iso.of_components (λ R, as_iso (to_Spec_Γ R) : _) (λ _ _, Spec_Γ_naturality)

end Spec_Γ

/-- The stalk map of `Spec M⁻¹R ⟶ Spec R` is an iso for each `p : Spec M⁻¹R`. -/
lemma Spec_map_localization_is_iso (R : CommRing) (M : submonoid R)
  (x : prime_spectrum (localization M)) :
  is_iso (PresheafedSpace.stalk_map (Spec.to_PresheafedSpace.map
    (CommRing.of_hom (algebra_map R (localization M))).op) x) :=
begin
  erw ← local_ring_hom_comp_stalk_iso,
  apply_with is_iso.comp_is_iso { instances := ff },
  apply_instance,
  apply_with is_iso.comp_is_iso { instances := ff },
  /- I do not know why this is defeq to the goal, but I'm happy to accept that it is. -/
  exact (show is_iso (is_localization.localization_localization_at_prime_iso_localization
    M x.as_ideal).to_ring_equiv.to_CommRing_iso.hom, by apply_instance),
  apply_instance
end

namespace structure_sheaf

variables {R S : CommRing.{u}} (f : R ⟶ S) (p : prime_spectrum R)

/--
For an algebra `f : R →+* S`, this is the ring homomorphism `S →+* (f∗ 𝒪ₛ)ₚ` for a `p : Spec R`.
This is shown to be the localization at `p` in `is_localized_module_to_pushforward_stalk_alg_hom`.
-/
def to_pushforward_stalk :
  S ⟶ (Spec.Top_map f _* (structure_sheaf S).1).stalk p :=
structure_sheaf.to_open S ⊤ ≫
  @Top.presheaf.germ _ _ _ _ (Spec.Top_map f _* (structure_sheaf S).1) ⊤ ⟨p, trivial⟩

@[reassoc]
lemma to_pushforward_stalk_comp :
  f ≫ structure_sheaf.to_pushforward_stalk f p =
  structure_sheaf.to_stalk R p ≫
    (Top.presheaf.stalk_functor _ _).map (Spec.SheafedSpace_map f).c :=
begin
  rw structure_sheaf.to_stalk,
  erw category.assoc,
  rw Top.presheaf.stalk_functor_map_germ,
  exact Spec_Γ_naturality_assoc f _,
end

instance : algebra R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) :=
(f ≫ structure_sheaf.to_pushforward_stalk f p).to_algebra

lemma algebra_map_pushforward_stalk :
  algebra_map R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) =
    f ≫ structure_sheaf.to_pushforward_stalk f p := rfl

variables (R S) [algebra R S]

/--
This is the `alg_hom` version of `to_pushforward_stalk`, which is the map `S ⟶ (f∗ 𝒪ₛ)ₚ` for some
algebra `R ⟶ S` and some `p : Spec R`.
-/
@[simps]
def to_pushforward_stalk_alg_hom :
  S →ₐ[R] (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).stalk p :=
{ commutes' := λ _, rfl, ..(structure_sheaf.to_pushforward_stalk (algebra_map R S) p) }

lemma is_localized_module_to_pushforward_stalk_alg_hom_aux (y) :
  ∃ (x : S × p.as_ideal.prime_compl), x.2 • y = to_pushforward_stalk_alg_hom R S p x.1 :=
begin
  obtain ⟨U, hp, s, e⟩ := Top.presheaf.germ_exist _ _ y,
  obtain ⟨_, ⟨r, rfl⟩, hpr : p ∈ prime_spectrum.basic_open r,
    hrU : prime_spectrum.basic_open r ≤ U⟩ := prime_spectrum.is_topological_basis_basic_opens
      .exists_subset_of_mem_open (show p ∈ ↑U, from hp) U.2,
  change prime_spectrum.basic_open r ≤ U at hrU,
  replace e := ((Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1)
    .germ_res_apply (hom_of_le hrU) ⟨p, hpr⟩ _).trans e,
  set s' := (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op s
    with h,
  rw ← h at e,
  clear_value s', clear_dependent U,
  obtain ⟨⟨s, ⟨_, n, rfl⟩⟩, hsn⟩ := @is_localization.surj _ _ _
    _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) s',
  refine ⟨⟨s, ⟨r, hpr⟩ ^ n⟩, _⟩,
  rw [submonoid.smul_def, algebra.smul_def, algebra_map_pushforward_stalk, to_pushforward_stalk,
    comp_apply, comp_apply],
  iterate 2 { erw ← (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).germ_res_apply
    (hom_of_le le_top) ⟨p, hpr⟩ },
  rw [← e, ← map_mul, mul_comm],
  dsimp only [subtype.coe_mk] at hsn,
  rw ← map_pow (algebra_map R S) at hsn,
  congr' 1
end

instance is_localized_module_to_pushforward_stalk_alg_hom :
  is_localized_module p.as_ideal.prime_compl (to_pushforward_stalk_alg_hom R S p).to_linear_map :=
begin
  apply is_localized_module.mk_of_algebra,
  { intros x hx, rw [algebra_map_pushforward_stalk, to_pushforward_stalk_comp, comp_apply],
    exact (is_localization.map_units ((structure_sheaf R).presheaf.stalk p) ⟨x, hx⟩).map _ },
  { apply is_localized_module_to_pushforward_stalk_alg_hom_aux },
  { intros x hx,
    rw [to_pushforward_stalk_alg_hom_apply, ring_hom.to_fun_eq_coe,
      ← (to_pushforward_stalk (algebra_map R S) p).map_zero, to_pushforward_stalk, comp_apply,
      comp_apply, map_zero] at hx,
    obtain ⟨U, hpU, i₁, i₂, e⟩ := Top.presheaf.germ_eq _ _ _ _ _ _ hx,
    obtain ⟨_, ⟨r, rfl⟩, hpr, hrU⟩ := prime_spectrum.is_topological_basis_basic_opens
      .exists_subset_of_mem_open (show p ∈ U.1, from hpU) U.2,
    change prime_spectrum.basic_open r ≤ U at hrU,
    apply_fun (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op at e,
    simp only [Top.presheaf.pushforward_obj_map, functor.op_map, map_zero, ← comp_apply,
      to_open_res] at e,
    have : to_open S (prime_spectrum.basic_open $ algebra_map R S r) x = 0,
    { refine eq.trans _ e, refl },
    have := (@is_localization.mk'_one _ _ _
      _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) x).trans this,
    obtain ⟨⟨_, n, rfl⟩, e⟩ := (is_localization.mk'_eq_zero_iff _ _).mp this,
    refine ⟨⟨r, hpr⟩ ^ n, _⟩,
    rw [submonoid.smul_def, algebra.smul_def, submonoid.coe_pow, subtype.coe_mk, map_pow],
    exact e },
end

end structure_sheaf

end algebraic_geometry


/-
Copyright (c) 2020 Scott Morrison, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.shapes.products
import category_theory.limits.preserves.basic

/-!
# Preserving products

Constructions to relate the notions of preserving products and reflecting products
to concrete fans.

In particular, we show that `pi_comparison G f` is an isomorphism iff `G` preserves
the limit of `f`.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

variables {J : Type v} (f : J → C)

/--
The map of a fan is a limit iff the fan consisting of the mapped morphisms is a limit. This
essentially lets us commute `fan.mk` with `functor.map_cone`.
-/
def is_limit_map_cone_fan_mk_equiv {P : C} (g : Π j, P ⟶ f j) :
  is_limit (G.map_cone (fan.mk P g)) ≃
  is_limit (fan.mk _ (λ j, G.map (g j)) : fan (λ j, G.obj (f j))) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))),
  refine cones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }),
end

/-- The property of preserving products expressed in terms of fans. -/
def is_limit_fan_mk_obj_of_is_limit [preserves_limit (discrete.functor f) G]
  {P : C} (g : Π j, P ⟶ f j) (t : is_limit (fan.mk _ g)) :
  is_limit (fan.mk (G.obj P) (λ j, G.map (g j)) : fan (λ j, G.obj (f j))) :=
is_limit_map_cone_fan_mk_equiv _ _ _ (preserves_limit.preserves t)

/-- The property of reflecting products expressed in terms of fans. -/
def is_limit_of_is_limit_fan_mk_obj [reflects_limit (discrete.functor f) G]
  {P : C} (g : Π j, P ⟶ f j) (t : is_limit (fan.mk _ (λ j, G.map (g j)) : fan (λ j, G.obj (f j)))) :
  is_limit (fan.mk P g) :=
reflects_limit.reflects ((is_limit_map_cone_fan_mk_equiv _ _ _).symm t)

section

variables [has_product f]

/--
If `G` preserves products and `C` has them, then the fan constructed of the mapped projection of a
product is a limit.
-/
def is_limit_of_has_product_of_preserves_limit [preserves_limit (discrete.functor f) G] :
  is_limit (fan.mk _ (λ (j : J), G.map (pi.π f j)) : fan (λ j, G.obj (f j))) :=
is_limit_fan_mk_obj_of_is_limit G f _ (product_is_product _)

variables [has_product (λ (j : J), G.obj (f j))]

/-- If `pi_comparison G f` is an isomorphism, then `G` preserves the limit of `f`. -/
def preserves_product.of_iso_comparison [i : is_iso (pi_comparison G f)] :
  preserves_limit (discrete.functor f) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (product_is_product f),
  apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (discrete.functor (λ (j : J), G.obj (f j)))),
  apply i,
end

variable [preserves_limit (discrete.functor f) G]

/--
If `G` preserves limits, we have an isomorphism from the image of a product to the product of the
images.
-/
def preserves_product.iso : G.obj (∏ f) ≅ ∏ (λ j, G.obj (f j)) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_product_of_preserves_limit G f)
  (limit.is_limit _)

@[simp]
lemma preserves_product.iso_hom : (preserves_product.iso G f).hom = pi_comparison G f :=
rfl

instance : is_iso (pi_comparison G f) :=
begin
  rw ← preserves_product.iso_hom,
  apply_instance,
end

end

/--
The map of a cofan is a colimit iff the cofan consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofan.mk` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofan_mk_equiv {P : C} (g : Π j, f j ⟶ P) :
  is_colimit (G.map_cocone (cofan.mk P g)) ≃
  is_colimit (cofan.mk _ (λ j, G.map (g j)) : cofan (λ j, G.obj (f j))) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))),
  refine cocones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }),
end

/-- The property of preserving coproducts expressed in terms of cofans. -/
def is_colimit_cofan_mk_obj_of_is_colimit [preserves_colimit (discrete.functor f) G]
  {P : C} (g : Π j, f j ⟶ P) (t : is_colimit (cofan.mk _ g)) :
  is_colimit (cofan.mk (G.obj P) (λ j, G.map (g j)) : cofan (λ j, G.obj (f j))) :=
is_colimit_map_cocone_cofan_mk_equiv _ _ _ (preserves_colimit.preserves t)

/-- The property of reflecting coproducts expressed in terms of cofans. -/
def is_colimit_of_is_colimit_cofan_mk_obj [reflects_colimit (discrete.functor f) G]
  {P : C} (g : Π j, f j ⟶ P)
  (t : is_colimit (cofan.mk _ (λ j, G.map (g j)) : cofan (λ j, G.obj (f j)))) :
  is_colimit (cofan.mk P g) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm t)

section

variables [has_coproduct f]

/--
If `G` preserves coproducts and `C` has them,
then the cofan constructed of the mapped inclusion of a coproduct is a colimit.
-/
def is_colimit_of_has_coproduct_of_preserves_colimit [preserves_colimit (discrete.functor f) G] :
  is_colimit (cofan.mk _ (λ (j : J), G.map (sigma.ι f j)) : cofan (λ j, G.obj (f j))) :=
is_colimit_cofan_mk_obj_of_is_colimit G f _ (coproduct_is_coproduct _)

variables [has_coproduct (λ (j : J), G.obj (f j))]

/-- If `sigma_comparison G f` is an isomorphism, then `G` preserves the colimit of `f`. -/
def preserves_coproduct.of_iso_comparison [i : is_iso (sigma_comparison G f)] :
  preserves_colimit (discrete.functor f) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coproduct_is_coproduct f),
  apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (discrete.functor (λ (j : J), G.obj (f j)))),
  apply i,
end

variable [preserves_colimit (discrete.functor f) G]

/--
If `G` preserves colimits,
we have an isomorphism from the image of a coproduct to the coproduct of the images.
-/
def preserves_coproduct.iso : G.obj (∐ f) ≅ ∐ (λ j, G.obj (f j)) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_coproduct_of_preserves_colimit G f)
  (colimit.is_colimit _)

@[simp]
lemma preserves_coproduct.inv_hom : (preserves_coproduct.iso G f).inv = sigma_comparison G f :=
rfl

instance : is_iso (sigma_comparison G f) :=
begin
  rw ← preserves_coproduct.inv_hom,
  apply_instance,
end

end

end category_theory.limits


inductive Two : Type
| C21 : Two
| C22 : Two

inductive Three : Type
| C31 : Three
| C32 : Three
| C33 : Three

theorem two_is_not_three : Two ≠ Three := begin
    intro two_is_three,
    have hatonosu : ∀a b c: Two, a = b ∨ b = c ∨ c = a :=
        by intros a b c; cases a; cases b; cases c; simp,
    rw two_is_three at hatonosu,
    have uso := hatonosu Three.C31 Three.C32 Three.C33,
    simp at uso,
    assumption
end