/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.group.pi
import category_theory.limits.shapes.biproducts
import algebra.category.Module.limits
import algebra.homology.short_exact.abelian

/-!
# The category of `R`-modules has finite biproducts
-/

open category_theory
open category_theory.limits

open_locale big_operators

universes v u

namespace Module

variables {R : Type u} [ring R]

-- As `Module R` is preadditive, and has all limits, it automatically has biproducts.
instance : has_binary_biproducts (Module.{v} R) :=
has_binary_biproducts.of_has_binary_products

instance : has_finite_biproducts (Module.{v} R) :=
has_finite_biproducts.of_has_finite_products

-- We now construct explicit limit data,
-- so we can compare the biproducts to the usual unbundled constructions.

/--
Construct limit data for a binary product in `Module R`, using `Module.of R (M × N)`.
-/
@[simps cone_X is_limit_lift]
def binary_product_limit_cone (M N : Module.{v} R) : limits.limit_cone (pair M N) :=
{ cone :=
  { X := Module.of R (M × N),
    π :=
    { app := λ j, discrete.cases_on j
        (λ j, walking_pair.cases_on j (linear_map.fst R M N) (linear_map.snd R M N)),
      naturality' := by rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟨⟩⟩⟩; refl,  }},
  is_limit :=
  { lift := λ s, linear_map.prod (s.π.app ⟨walking_pair.left⟩) (s.π.app ⟨walking_pair.right⟩),
    fac' := by { rintros s (⟨⟩|⟨⟩); { ext x, simp, }, },
    uniq' := λ s m w,
    begin
      ext; [rw ← w ⟨walking_pair.left⟩, rw ← w ⟨walking_pair.right⟩]; refl,
    end, } }

@[simp] lemma binary_product_limit_cone_cone_π_app_left (M N : Module.{v} R) :
  (binary_product_limit_cone M N).cone.π.app ⟨walking_pair.left⟩ = linear_map.fst R M N := rfl

@[simp] lemma binary_product_limit_cone_cone_π_app_right (M N : Module.{v} R) :
  (binary_product_limit_cone M N).cone.π.app ⟨walking_pair.right⟩ = linear_map.snd R M N := rfl

/--
We verify that the biproduct in `Module R` is isomorphic to
the cartesian product of the underlying types:
-/
@[simps hom_apply] noncomputable
def biprod_iso_prod (M N : Module.{v} R) : (M ⊞ N : Module.{v} R) ≅ Module.of R (M × N) :=
is_limit.cone_point_unique_up_to_iso
  (binary_biproduct.is_limit M N)
  (binary_product_limit_cone M N).is_limit

@[simp, elementwise] lemma biprod_iso_prod_inv_comp_fst (M N : Module.{v} R) :
  (biprod_iso_prod M N).inv ≫ biprod.fst = linear_map.fst R M N :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.left)

@[simp, elementwise] lemma biprod_iso_prod_inv_comp_snd (M N : Module.{v} R) :
  (biprod_iso_prod M N).inv ≫ biprod.snd = linear_map.snd R M N :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.right)

variables {J : Type v} (f : J → Module.{v} R)

namespace has_limit

/--
The map from an arbitrary cone over a indexed family of abelian groups
to the cartesian product of those groups.
-/
@[simps]
def lift (s : fan f) :
  s.X ⟶ Module.of R (Π j, f j) :=
{ to_fun := λ x j, s.π.app ⟨j⟩ x,
  map_add' := λ x y, by { ext, simp, },
  map_smul' := λ r x, by { ext, simp, }, }

/--
Construct limit data for a product in `Module R`, using `Module.of R (Π j, F.obj j)`.
-/
@[simps] def product_limit_cone : limits.limit_cone (discrete.functor f) :=
{ cone :=
  { X := Module.of R (Π j, f j),
    π := discrete.nat_trans (λ j, (linear_map.proj j.as : (Π j, f j) →ₗ[R] f j.as)), },
  is_limit :=
  { lift := lift f,
    fac' := λ s j, by { cases j, ext, simp, },
    uniq' := λ s m w,
    begin
      ext x j,
      dsimp only [has_limit.lift],
      simp only [linear_map.coe_mk],
      exact congr_arg (λ g : s.X ⟶ f j, (g : s.X → f j) x) (w ⟨j⟩),
    end, }, }

end has_limit

open has_limit

/--
We verify that the biproduct we've just defined is isomorphic to the `Module R` structure
on the dependent function type
-/
@[simps hom_apply] noncomputable
def biproduct_iso_pi [fintype J] (f : J → Module.{v} R) :
  (⨁ f : Module.{v} R) ≅ Module.of R (Π j, f j) :=
is_limit.cone_point_unique_up_to_iso
  (biproduct.is_limit f)
  (product_limit_cone f).is_limit

@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π [fintype J]
  (f : J → Module.{v} R) (j : J) :
  (biproduct_iso_pi f).inv ≫ biproduct.π f j = (linear_map.proj j : (Π j, f j) →ₗ[R] f j) :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk j)

end Module

section split_exact

variables {R : Type u} {A M B : Type v} [ring R] [add_comm_group A] [module R A]
  [add_comm_group B] [module R B] [add_comm_group M] [module R M]
variables {j : A →ₗ[R] M} {g : M →ₗ[R] B}
open Module

/--The isomorphism `A × B ≃ₗ[R] M` coming from a right split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0`
of modules.-/
noncomputable def lequiv_prod_of_right_split_exact {f : B →ₗ[R] M}
  (hj : function.injective j) (exac : j.range = g.ker) (h : g.comp f = linear_map.id) :
  (A × B) ≃ₗ[R] M :=
(({ right_split := ⟨as_hom f, h⟩,
    mono := (Module.mono_iff_injective $ as_hom j).mpr hj,
    exact := (exact_iff _ _).mpr exac } : right_split _ _).splitting.iso.trans $
  biprod_iso_prod _ _).to_linear_equiv.symm

/--The isomorphism `A × B ≃ₗ[R] M` coming from a left split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0`
of modules.-/
noncomputable def lequiv_prod_of_left_split_exact {f : M →ₗ[R] A}
  (hg : function.surjective g) (exac : j.range = g.ker) (h : f.comp j = linear_map.id) :
  (A × B) ≃ₗ[R] M :=
(({ left_split := ⟨as_hom f, h⟩,
    epi := (Module.epi_iff_surjective $ as_hom g).mpr hg,
    exact := (exact_iff _ _).mpr exac } : left_split _ _).splitting.iso.trans $
  biprod_iso_prod _ _).to_linear_equiv.symm

end split_exact


/-
Copyright (c) 2022 Antoine Labelle, Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle, Rémi Bottinelli
-/
import combinatorics.quiver.basic
import combinatorics.quiver.path

/-!

# Rewriting arrows and paths along vertex equalities

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

This files defines `hom.cast` and `path.cast` (and associated lemmas) in order to allow
rewriting arrows and paths along equalities of their endpoints.

-/

universes v v₁ v₂ u u₁ u₂

variables {U : Type*} [quiver.{u+1} U]

namespace quiver

/-!
### Rewriting arrows along equalities of vertices
-/

/-- Change the endpoints of an arrow using equalities. -/
def hom.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) : u' ⟶ v' :=
eq.rec (eq.rec e hv) hu

@[simp] lemma hom.cast_rfl_rfl {u v : U} (e : u ⟶ v) :
  e.cast rfl rfl = e := rfl

@[simp] lemma hom.cast_cast {u v u' v' u'' v'' : U} (e : u ⟶ v)
  (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') :
  (e.cast hu hv).cast hu' hv' = e.cast (hu.trans hu') (hv.trans hv') :=
by { subst_vars, refl }

lemma hom.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) :
  e.cast hu hv == e :=
by { subst_vars, refl }

lemma hom.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
  (e : u ⟶ v) (e' : u' ⟶ v') : e.cast hu hv = e' ↔ e == e' :=
by { rw hom.cast_eq_cast, exact cast_eq_iff_heq }

lemma hom.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
  (e : u ⟶ v) (e' : u' ⟶ v') : e' = e.cast hu hv ↔ e' == e :=
by { rw [eq_comm, hom.cast_eq_iff_heq], exact ⟨heq.symm, heq.symm⟩ }

/-!
### Rewriting paths along equalities of vertices
-/

open path

/-- Change the endpoints of a path using equalities. -/
def path.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) : path u' v' :=
eq.rec (eq.rec p hv) hu

lemma path.cast_eq_cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) :
  p.cast hu hv = cast (by rw [hu, hv]) p:=
eq.drec (eq.drec (eq.refl (path.cast (eq.refl u) (eq.refl v) p)) hu) hv

@[simp] lemma path.cast_rfl_rfl {u v : U} (p : path u v) :
  p.cast rfl rfl = p := rfl

@[simp] lemma path.cast_cast {u v u' v' u'' v'' : U} (p : path u v)
  (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') :
  (p.cast hu hv).cast hu' hv' = p.cast (hu.trans hu') (hv.trans hv') :=
by { subst_vars, refl }

@[simp] lemma path.cast_nil {u u' : U} (hu : u = u') :
  (path.nil : path u u).cast hu hu = path.nil :=
by { subst_vars, refl }

lemma path.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) :
  p.cast hu hv == p :=
by { rw path.cast_eq_cast, exact cast_heq _ _ }

lemma path.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
  (p : path u v) (p' : path u' v') : p.cast hu hv = p' ↔ p == p' :=
by { rw path.cast_eq_cast, exact cast_eq_iff_heq }

lemma path.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
  (p : path u v) (p' : path u' v') : p' = p.cast hu hv ↔ p' == p :=
⟨λ h, ((p.cast_eq_iff_heq hu hv p').1 h.symm).symm,
 λ h, ((p.cast_eq_iff_heq hu hv p').2 h.symm).symm⟩

lemma path.cast_cons {u v w u' w' : U} (p : path u v) (e : v ⟶ w) (hu : u = u') (hw : w = w') :
  (p.cons e).cast hu hw = (p.cast hu rfl).cons (e.cast rfl hw) :=
by { subst_vars, refl }

lemma cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'}
  {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') :
  p.cast rfl (obj_eq_of_cons_eq_cons h) = p' :=
by { rw path.cast_eq_iff_heq, exact heq_of_cons_eq_cons h }

lemma hom_cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'}
  {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') :
  e.cast (obj_eq_of_cons_eq_cons h) rfl = e' :=
by { rw hom.cast_eq_iff_heq, exact hom_heq_of_cons_eq_cons h }

lemma eq_nil_of_length_zero {u v : U} (p : path u v) (hzero : p.length = 0) :
  p.cast (eq_of_length_zero p hzero) rfl = path.nil :=
by { cases p; simpa only [nat.succ_ne_zero, length_cons] using hzero, }

end quiver


/-
Copyright (c) 2021 Eric Weiser. 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.algebra.subalgebra.pointwise
! leanprover-community/mathlib commit b2c707cd190a58ea0565c86695a19e99ccecc215
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Operations
import Mathlib.Algebra.Algebra.Subalgebra.Basic
import Mathlib.RingTheory.Subring.Pointwise
import Mathlib.RingTheory.Adjoin.Basic

/-!
# Pointwise actions on subalgebras.

If `R'` acts on an `R`-algebra `A` (so that `R'` and `R` actions commute)
then we get an `R'` action on the collection of `R`-subalgebras.
-/

namespace Subalgebra

section Pointwise

variable {R : Type _} {A : Type _} [CommSemiring R] [Semiring A] [Algebra R A]

theorem mul_toSubmodule_le (S T : Subalgebra R A) :
    (Subalgebra.toSubmodule S)* (Subalgebra.toSubmodule T) ≤ Subalgebra.toSubmodule (S ⊔ T) := by
  rw [Submodule.mul_le]
  intro y hy z hz
  show y * z ∈ S ⊔ T
  exact mul_mem (Algebra.mem_sup_left hy) (Algebra.mem_sup_right hz)
#align subalgebra.mul_to_submodule_le Subalgebra.mul_toSubmodule_le

/-- As submodules, subalgebras are idempotent. -/
@[simp]
theorem mul_self (S : Subalgebra R A) : (Subalgebra.toSubmodule S) * (Subalgebra.toSubmodule S)
    = (Subalgebra.toSubmodule S) := by
  apply le_antisymm
  · refine' (mul_toSubmodule_le _ _).trans_eq _
    rw [sup_idem]
  · intro x hx1
    rw [← mul_one x]
    exact Submodule.mul_mem_mul hx1 (show (1 : A) ∈ S from one_mem S)
#align subalgebra.mul_self Subalgebra.mul_self

/-- When `A` is commutative, `Subalgebra.mul_toSubmodule_le` is strict. -/
theorem mul_toSubmodule {R : Type _} {A : Type _} [CommSemiring R] [CommSemiring A] [Algebra R A]
    (S T : Subalgebra R A) : (Subalgebra.toSubmodule S) * (Subalgebra.toSubmodule T)
        = Subalgebra.toSubmodule (S ⊔ T) := by
  refine' le_antisymm (mul_toSubmodule_le _ _) _
  rintro x (hx : x ∈ Algebra.adjoin R (S ∪ T : Set A))
  refine'
    Algebra.adjoin_induction hx (fun x hx => _) (fun r => _) (fun _ _ => Submodule.add_mem _)
      fun x y hx hy => _
  · cases' hx with hxS hxT
    · rw [← mul_one x]
      exact Submodule.mul_mem_mul hxS (show (1 : A) ∈ T from one_mem T)
    · rw [← one_mul x]
      exact Submodule.mul_mem_mul (show (1 : A) ∈ S from one_mem S) hxT
  · rw [← one_mul (algebraMap _ _ _)]
    exact Submodule.mul_mem_mul (show (1 : A) ∈ S from one_mem S) (algebraMap_mem _ _)
  have := Submodule.mul_mem_mul hx hy
  rwa [mul_assoc, mul_comm _ (Subalgebra.toSubmodule T), ← mul_assoc _ _ (Subalgebra.toSubmodule S),
    mul_self, mul_comm (Subalgebra.toSubmodule T), ← mul_assoc, mul_self] at this
#align subalgebra.mul_to_submodule Subalgebra.mul_toSubmodule

variable {R' : Type _} [Semiring R'] [MulSemiringAction R' A] [SMulCommClass R' R A]

/-- The action on a subalgebra corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwiseMulAction : MulAction R' (Subalgebra R A)
    where
  smul a S := S.map (MulSemiringAction.toAlgHom _ _ a)
  one_smul S := (congr_arg (fun f => S.map f) (AlgHom.ext <| one_smul R')).trans S.map_id
  mul_smul _a₁ _a₂ S :=
    (congr_arg (fun f => S.map f) (AlgHom.ext <| mul_smul _ _)).trans (S.map_map _ _).symm
#align subalgebra.pointwise_mul_action Subalgebra.pointwiseMulAction

scoped[Pointwise] attribute [instance] Subalgebra.pointwiseMulAction

open Pointwise

@[simp]
theorem coe_pointwise_smul (m : R') (S : Subalgebra R A) : ↑(m • S) = m • (S : Set A) :=
  rfl
#align subalgebra.coe_pointwise_smul Subalgebra.coe_pointwise_smul

@[simp]
theorem pointwise_smul_toSubsemiring (m : R') (S : Subalgebra R A) :
    (m • S).toSubsemiring = m • S.toSubsemiring :=
  rfl
#align subalgebra.pointwise_smul_to_subsemiring Subalgebra.pointwise_smul_toSubsemiring

@[simp]
theorem pointwise_smul_toSubmodule (m : R') (S : Subalgebra R A) :
    Subalgebra.toSubmodule (m • S) = m • Subalgebra.toSubmodule S :=
  rfl
#align subalgebra.pointwise_smul_to_submodule Subalgebra.pointwise_smul_toSubmodule

@[simp]
theorem pointwise_smul_toSubring {R' R A : Type _} [Semiring R'] [CommRing R] [Ring A]
    [MulSemiringAction R' A] [Algebra R A] [SMulCommClass R' R A] (m : R') (S : Subalgebra R A) :
    (m • S).toSubring = m • S.toSubring :=
  rfl
#align subalgebra.pointwise_smul_to_subring Subalgebra.pointwise_smul_toSubring

theorem smul_mem_pointwise_smul (m : R') (r : A) (S : Subalgebra R A) : r ∈ S → m • r ∈ m • S :=
  (Set.smul_mem_smul_set : _ → _ ∈ m • (S : Set A))
#align subalgebra.smul_mem_pointwise_smul Subalgebra.smul_mem_pointwise_smul

end Pointwise

end Subalgebra