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

! This file was ported from Lean 3 source module category_theory.adjunction.reflective
! leanprover-community/mathlib commit 239d882c4fb58361ee8b3b39fb2091320edef10a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.FullyFaithful
import Mathlib.CategoryTheory.Functor.ReflectsIso
import Mathlib.CategoryTheory.EpiMono

/-!
# Reflective functors

Basic properties of reflective functors, especially those relating to their essential image.

Note properties of reflective functors relating to limits and colimits are included in
`CategoryTheory.Monad.Limits`.
-/

universe v₁ v₂ v₃ u₁ u₂ u₃

noncomputable section

namespace CategoryTheory

open Category Adjunction

variable {C : Type u₁} {D : Type u₂} {E : Type u₃}

variable [Category.{v₁} C] [Category.{v₂} D] [Category.{v₃} E]

/--
A functor is *reflective*, or *a reflective inclusion*, if it is fully faithful and right adjoint.
-/
class Reflective (R : D ⥤ C) extends IsRightAdjoint R, Full R, Faithful R
#align category_theory.reflective CategoryTheory.Reflective

variable {i : D ⥤ C}

-- TODO: This holds more generally for idempotent adjunctions, not just reflective adjunctions.
/-- For a reflective functor `i` (with left adjoint `L`), with unit `η`, we have `η_iL = iL η`.
-/
theorem unit_obj_eq_map_unit [Reflective i] (X : C) :
    (ofRightAdjoint i).unit.app (i.obj ((leftAdjoint i).obj X)) =
      i.map ((leftAdjoint i).map ((ofRightAdjoint i).unit.app X)) := by
  rw [← cancel_mono (i.map ((ofRightAdjoint i).counit.app ((leftAdjoint i).obj X))), ←
    i.map_comp]
  simp
#align category_theory.unit_obj_eq_map_unit CategoryTheory.unit_obj_eq_map_unit

/--
When restricted to objects in `D` given by `i : D ⥤ C`, the unit is an isomorphism. In other words,
`η_iX` is an isomorphism for any `X` in `D`.
More generally this applies to objects essentially in the reflective subcategory, see
`Functor.essImage.unit_isIso`.
-/
instance isIso_unit_obj [Reflective i] {B : D} : IsIso ((ofRightAdjoint i).unit.app (i.obj B)) := by
  have :
    (ofRightAdjoint i).unit.app (i.obj B) = inv (i.map ((ofRightAdjoint i).counit.app B)) :=
    by
    rw [← comp_hom_eq_id]
    apply (ofRightAdjoint i).right_triangle_components
  rw [this]
  exact IsIso.inv_isIso
#align category_theory.is_iso_unit_obj CategoryTheory.isIso_unit_obj

/-- If `A` is essentially in the image of a reflective functor `i`, then `η_A` is an isomorphism.
This gives that the "witness" for `A` being in the essential image can instead be given as the
reflection of `A`, with the isomorphism as `η_A`.

(For any `B` in the reflective subcategory, we automatically have that `ε_B` is an iso.)
-/
theorem Functor.essImage.unit_isIso [Reflective i] {A : C} (h : A ∈ i.essImage) :
    IsIso ((ofRightAdjoint i).unit.app A) := by
  suffices
    (ofRightAdjoint i).unit.app A =
      h.getIso.inv ≫
        (ofRightAdjoint i).unit.app (i.obj (Functor.essImage.witness h)) ≫
          (leftAdjoint i ⋙ i).map h.getIso.hom
    by
    rw [this]
    infer_instance
  rw [← NatTrans.naturality]
  simp
#align category_theory.functor.ess_image.unit_is_iso CategoryTheory.Functor.essImage.unit_isIso

/-- If `η_A` is an isomorphism, then `A` is in the essential image of `i`. -/

/-- If `η_A` is a split monomorphism, then `A` is in the reflective subcategory. -/
theorem mem_essImage_of_unit_isSplitMono [Reflective i] {A : C}
    [IsSplitMono ((ofRightAdjoint i).unit.app A)] : A ∈ i.essImage := by
  let η : 𝟭 C ⟶ leftAdjoint i ⋙ i := (ofRightAdjoint i).unit
  haveI : IsIso (η.app (i.obj ((leftAdjoint i).obj A))) :=
    Functor.essImage.unit_isIso ((i.obj_mem_essImage _))
  have : Epi (η.app A) := by
    refine @epi_of_epi _ _ _ _ _ (retraction (η.app A)) (η.app A) ?_
    rw [show retraction _ ≫ η.app A = _ from η.naturality (retraction (η.app A))]
    apply epi_comp (η.app (i.obj ((leftAdjoint i).obj A)))
  skip
  haveI := isIso_of_epi_of_isSplitMono (η.app A)
  exact mem_essImage_of_unit_isIso A
#align category_theory.mem_ess_image_of_unit_is_split_mono CategoryTheory.mem_essImage_of_unit_isSplitMono

/-- Composition of reflective functors. -/
instance Reflective.comp (F : C ⥤ D) (G : D ⥤ E) [Reflective F] [Reflective G] :
    Reflective (F ⋙ G) where toFaithful := Faithful.comp F G
#align category_theory.reflective.comp CategoryTheory.Reflective.comp

/-- (Implementation) Auxiliary definition for `unitCompPartialBijective`. -/
def unitCompPartialBijectiveAux [Reflective i] (A : C) (B : D) :
    (A ⟶ i.obj B) ≃ (i.obj ((leftAdjoint i).obj A) ⟶ i.obj B) :=
  ((Adjunction.ofRightAdjoint i).homEquiv _ _).symm.trans (equivOfFullyFaithful i)
#align category_theory.unit_comp_partial_bijective_aux CategoryTheory.unitCompPartialBijectiveAux

/-- The description of the inverse of the bijection `unitCompPartialBijectiveAux`. -/
theorem unitCompPartialBijectiveAux_symm_apply [Reflective i] {A : C} {B : D}
    (f : i.obj ((leftAdjoint i).obj A) ⟶ i.obj B) :
    (unitCompPartialBijectiveAux _ _).symm f = (ofRightAdjoint i).unit.app A ≫ f := by
  simp [unitCompPartialBijectiveAux]
#align category_theory.unit_comp_partial_bijective_aux_symm_apply CategoryTheory.unitCompPartialBijectiveAux_symm_apply

/-- If `i` has a reflector `L`, then the function `(i.obj (L.obj A) ⟶ B) → (A ⟶ B)` given by
precomposing with `η.app A` is a bijection provided `B` is in the essential image of `i`.
That is, the function `λ (f : i.obj (L.obj A) ⟶ B), η.app A ≫ f` is bijective, as long as `B` is in
the essential image of `i`.
This definition gives an equivalence: the key property that the inverse can be described
nicely is shown in `unitCompPartialBijective_symm_apply`.

This establishes there is a natural bijection `(A ⟶ B) ≃ (i.obj (L.obj A) ⟶ B)`. In other words,
from the point of view of objects in `D`, `A` and `i.obj (L.obj A)` look the same: specifically
that `η.app A` is an isomorphism.
-/
def unitCompPartialBijective [Reflective i] (A : C) {B : C} (hB : B ∈ i.essImage) :
    (A ⟶ B) ≃ (i.obj ((leftAdjoint i).obj A) ⟶ B) :=
  calc
    (A ⟶ B) ≃ (A ⟶ i.obj (Functor.essImage.witness hB)) := Iso.homCongr (Iso.refl _) hB.getIso.symm
    _ ≃ (i.obj _ ⟶ i.obj (Functor.essImage.witness hB)) := unitCompPartialBijectiveAux _ _
    _ ≃ (i.obj ((leftAdjoint i).obj A) ⟶ B) :=
      Iso.homCongr (Iso.refl _) (Functor.essImage.getIso hB)
#align category_theory.unit_comp_partial_bijective CategoryTheory.unitCompPartialBijective

@[simp]
theorem unitCompPartialBijective_symm_apply [Reflective i] (A : C) {B : C} (hB : B ∈ i.essImage)
    (f) : (unitCompPartialBijective A hB).symm f = (ofRightAdjoint i).unit.app A ≫ f := by
  simp [unitCompPartialBijective, unitCompPartialBijectiveAux_symm_apply]
#align category_theory.unit_comp_partial_bijective_symm_apply CategoryTheory.unitCompPartialBijective_symm_apply

theorem unitCompPartialBijective_symm_natural [Reflective i] (A : C) {B B' : C} (h : B ⟶ B')
    (hB : B ∈ i.essImage) (hB' : B' ∈ i.essImage) (f : i.obj ((leftAdjoint i).obj A) ⟶ B) :
    (unitCompPartialBijective A hB').symm (f ≫ h) = (unitCompPartialBijective A hB).symm f ≫ h := by
  simp
#align category_theory.unit_comp_partial_bijective_symm_natural CategoryTheory.unitCompPartialBijective_symm_natural

theorem unitCompPartialBijective_natural [Reflective i] (A : C) {B B' : C} (h : B ⟶ B')
    (hB : B ∈ i.essImage) (hB' : B' ∈ i.essImage) (f : A ⟶ B) :
    (unitCompPartialBijective A hB') (f ≫ h) = unitCompPartialBijective A hB f ≫ h := by
  rw [← Equiv.eq_symm_apply, unitCompPartialBijective_symm_natural A h, Equiv.symm_apply_apply]
#align category_theory.unit_comp_partial_bijective_natural CategoryTheory.unitCompPartialBijective_natural

instance [Reflective i] (X : Functor.EssImageSubcategory i) :
  IsIso (NatTrans.app (ofRightAdjoint i).unit X.obj) :=
Functor.essImage.unit_isIso X.property

-- porting note: the following auxiliary definition and the next two lemmas were
-- introduced in order to ease the port
/-- The counit isomorphism of the equivalence `D ≌ i.EssImageSubcategory` given
by `equivEssImageOfReflective` when the functor `i` is reflective. -/
def equivEssImageOfReflective_counitIso_app [Reflective i] (X : Functor.EssImageSubcategory i) :
  ((Functor.essImageInclusion i ⋙ leftAdjoint i) ⋙ Functor.toEssImage i).obj X ≅ X := by
  refine' Iso.symm (@asIso _ _ X _ ((ofRightAdjoint i).unit.app X.obj) ?_)
  refine @isIso_of_reflects_iso _ _ _ _ _ _ _ i.essImageInclusion ?_ _
  dsimp
  exact inferInstance

lemma equivEssImageOfReflective_map_counitIso_app_hom [Reflective i]
  (X : Functor.EssImageSubcategory i) :
  (Functor.essImageInclusion i).map (equivEssImageOfReflective_counitIso_app X).hom =
    inv (NatTrans.app (ofRightAdjoint i).unit X.obj) := by
    simp [equivEssImageOfReflective_counitIso_app, asIso]
    rfl

lemma equivEssImageOfReflective_map_counitIso_app_inv [Reflective i]
  (X : Functor.EssImageSubcategory i) :
  (Functor.essImageInclusion i).map (equivEssImageOfReflective_counitIso_app X).inv =
    (NatTrans.app (ofRightAdjoint i).unit X.obj) := rfl

/-- If `i : D ⥤ C` is reflective, the inverse functor of `i ≌ F.essImage` can be explicitly
defined by the reflector. -/
@[simps]
def equivEssImageOfReflective [Reflective i] : D ≌ i.EssImageSubcategory
    where
  functor := i.toEssImage
  inverse := i.essImageInclusion ⋙ (leftAdjoint i : _)
  unitIso :=
    NatIso.ofComponents (fun X => (asIso <| (ofRightAdjoint i).counit.app X).symm)
      (by
        intro X Y f
        dsimp
        rw [IsIso.comp_inv_eq, Category.assoc, IsIso.eq_inv_comp]
        exact ((ofRightAdjoint i).counit.naturality f).symm)
  counitIso :=
    NatIso.ofComponents equivEssImageOfReflective_counitIso_app
      (by
        intro X Y f
        apply (Functor.essImageInclusion i).map_injective
        have h := ((ofRightAdjoint i).unit.naturality f).symm
        rw [Functor.id_map] at h
        erw [Functor.map_comp, Functor.map_comp,
          equivEssImageOfReflective_map_counitIso_app_hom,
          equivEssImageOfReflective_map_counitIso_app_hom,
          IsIso.comp_inv_eq, assoc, ← h, IsIso.inv_hom_id_assoc, Functor.comp_map])
  functor_unitIso_comp := fun X => by
    -- porting note: this proof was automatically handled by the automation in mathlib
    apply (Functor.essImageInclusion i).map_injective
    erw [Functor.map_comp, equivEssImageOfReflective_map_counitIso_app_hom]
    aesop_cat
#align category_theory.equiv_ess_image_of_reflective CategoryTheory.equivEssImageOfReflective

end CategoryTheory


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import algebra.hom.group_instances
import topology.algebra.uniform_group
import topology.algebra.uniform_mul_action
import topology.uniform_space.completion

/-!
# Completion of topological groups:

This files endows the completion of a topological abelian group with a group structure.
More precisely the instance `uniform_space.completion.add_group` builds an abelian group structure
on the completion of an abelian group endowed with a compatible uniform structure.
Then the instance `uniform_space.completion.uniform_add_group` proves this group structure is
compatible with the completed uniform structure. The compatibility condition is `uniform_add_group`.

## Main declarations:

Beyond the instances explained above (that don't have to be explicitly invoked),
the main constructions deal with continuous group morphisms.

* `add_monoid_hom.extension`: extends a continuous group morphism from `G`
  to a complete separated group `H` to `completion G`.
* `add_monoid_hom.completion`: promotes a continuous group morphism
  from `G` to `H` into a continuous group morphism
  from `completion G` to `completion H`.
-/

noncomputable theory

variables {M R α β : Type*}

section group
open uniform_space Cauchy filter set
variables [uniform_space α]

instance [has_zero α] : has_zero (completion α) := ⟨(0 : α)⟩
instance [has_neg α] : has_neg (completion α) := ⟨completion.map (λa, -a : α → α)⟩
instance [has_add α] : has_add (completion α) := ⟨completion.map₂ (+)⟩
instance [has_sub α] : has_sub (completion α) := ⟨completion.map₂ has_sub.sub⟩

@[norm_cast]
lemma uniform_space.completion.coe_zero [has_zero α] : ((0 : α) : completion α) = 0 := rfl
end group

namespace uniform_space.completion
open uniform_space

section has_zero

instance [uniform_space α] [monoid_with_zero M] [has_zero α] [mul_action_with_zero M α]
  [has_uniform_continuous_const_smul M α] :
  mul_action_with_zero M (completion α) :=
{ smul := (•),
  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, mul_action_with_zero.smul_zero r],
  zero_smul := ext' (continuous_const_smul _) continuous_const $ λ a,
    by rw [← coe_smul, zero_smul, coe_zero],
  .. completion.mul_action M α }

end has_zero

section uniform_add_group
variables [uniform_space α] [add_group α] [uniform_add_group α]

@[norm_cast]
lemma coe_neg (a : α) : ((- a : α) : completion α) = - a :=
(map_coe uniform_continuous_neg a).symm

@[norm_cast]
lemma coe_sub (a b : α) : ((a - b : α) : completion α) = a - b :=
(map₂_coe_coe a b has_sub.sub uniform_continuous_sub).symm

@[norm_cast]
lemma coe_add (a b : α) : ((a + b : α) : completion α) = a + b :=
(map₂_coe_coe a b (+) uniform_continuous_add).symm

instance : add_monoid (completion α) :=
{ zero_add     := assume a, completion.induction_on a
   (is_closed_eq (continuous_map₂ continuous_const continuous_id) continuous_id)
    (assume a, show 0 + (a : completion α) = a, by rw_mod_cast zero_add),
  add_zero     := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ continuous_id continuous_const) continuous_id)
    (assume a, show (a : completion α) + 0 = a, by rw_mod_cast add_zero),
  add_assoc    := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_map₂
        (continuous_map₂ continuous_fst (continuous_fst.comp continuous_snd))
        (continuous_snd.comp continuous_snd))
      (continuous_map₂ continuous_fst
        (continuous_map₂
          (continuous_fst.comp continuous_snd)
          (continuous_snd.comp continuous_snd))))
    (assume a b c, show (a : completion α) + b + c = a + (b + c),
      by repeat { rw_mod_cast add_assoc }),
  nsmul := (•),
  nsmul_zero' := λ a, completion.induction_on a (is_closed_eq continuous_map continuous_const)
    (λ a, by rw [←coe_smul, ←coe_zero, zero_smul]),
  nsmul_succ' := λ n a, completion.induction_on a
    (is_closed_eq continuous_map $ continuous_map₂ continuous_id continuous_map)
    (λ a, by rw_mod_cast succ_nsmul ),
  .. completion.has_zero, ..completion.has_add, }

instance : sub_neg_monoid (completion α) :=
{ sub_eq_add_neg := λ a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_fst (completion.continuous_map.comp continuous_snd)))
   (λ a b, by exact_mod_cast congr_arg coe (sub_eq_add_neg a b)),
  zsmul := (•),
  zsmul_zero' := λ a, completion.induction_on a (is_closed_eq continuous_map continuous_const)
    (λ a, by { rw_mod_cast zero_smul, refl} ),
  zsmul_succ' := λ n a, completion.induction_on a
    (is_closed_eq continuous_map $ continuous_map₂ continuous_id continuous_map)
    (λ a, by rw_mod_cast (show int.of_nat n.succ • a = a + int.of_nat n • a,
                          from sub_neg_monoid.zsmul_succ' n a) ),
  zsmul_neg' := λ n a, completion.induction_on a
    (is_closed_eq continuous_map $ completion.continuous_map.comp continuous_map)
    (λ a, by rw [←coe_smul, ←coe_smul, ←coe_neg, show -[1+ n] • a = -((n.succ : ℤ) • a),
                                                 from sub_neg_monoid.zsmul_neg' n a]),
  .. completion.add_monoid, .. completion.has_neg, .. completion.has_sub }

instance : add_group (completion α) :=
{ add_left_neg := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ completion.continuous_map continuous_id) continuous_const)
    (assume a, show - (a : completion α) + a = 0, by { rw_mod_cast add_left_neg, refl }),
  .. completion.sub_neg_monoid }

instance : uniform_add_group (completion α) :=
⟨uniform_continuous_map₂ has_sub.sub⟩

instance {M} [monoid M] [distrib_mul_action M α] [has_uniform_continuous_const_smul M α] :
  distrib_mul_action M (completion α) :=
{ smul := (•),
  smul_add := λ r x y, induction_on₂ x y
    (is_closed_eq ((continuous_fst.add continuous_snd).const_smul _)
      ((continuous_fst.const_smul _).add (continuous_snd.const_smul _)))
    (λ a b, by simp only [← coe_add, ← coe_smul, smul_add]),
  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, smul_zero r],
  .. completion.mul_action M α }

/-- The map from a group to its completion as a group hom. -/
@[simps] def to_compl : α →+ completion α :=
{ to_fun := coe,
  map_add' := coe_add,
  map_zero' := coe_zero }

lemma continuous_to_compl : continuous (to_compl : α → completion α) :=
continuous_coe α

end uniform_add_group

section uniform_add_comm_group
variables [uniform_space α] [add_comm_group α] [uniform_add_group α]

instance : add_comm_group (completion α) :=
{ add_comm  := assume a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_snd continuous_fst))
    (assume x y, by { change ↑x + ↑y = ↑y + ↑x, rw [← coe_add, ← coe_add, add_comm]}),
  .. completion.add_group }

instance [semiring R] [module R α] [has_uniform_continuous_const_smul R α] :
  module R (completion α) :=
{ smul := (•),
  add_smul := λ a b, ext' (continuous_const_smul _)
    ((continuous_const_smul _).add (continuous_const_smul _)) $ λ x, by { norm_cast, rw add_smul },
  .. completion.distrib_mul_action, .. completion.mul_action_with_zero }

end uniform_add_comm_group

end uniform_space.completion

section add_monoid_hom
variables [uniform_space α] [add_group α] [uniform_add_group α]
          [uniform_space β] [add_group β] [uniform_add_group β]

open uniform_space uniform_space.completion

/-- Extension to the completion of a continuous group hom. -/
def add_monoid_hom.extension [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) : completion α →+ β :=
have hf : uniform_continuous f, from uniform_continuous_add_monoid_hom_of_continuous hf,
{ to_fun := completion.extension f,
  map_zero' := by rw [← coe_zero, extension_coe hf, f.map_zero],
  map_add' := assume a b, completion.induction_on₂ a b
  (is_closed_eq
    (continuous_extension.comp continuous_add)
    ((continuous_extension.comp continuous_fst).add (continuous_extension.comp continuous_snd)))
  (λ a b, by rw_mod_cast [extension_coe hf, extension_coe hf, extension_coe hf,
    f.map_add]) }

lemma add_monoid_hom.extension_coe [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) (a : α) : f.extension hf a = f a :=
extension_coe (uniform_continuous_add_monoid_hom_of_continuous hf) a

@[continuity]
lemma add_monoid_hom.continuous_extension [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) : continuous (f.extension hf) :=
continuous_extension

/-- Completion of a continuous group hom, as a group hom. -/
def add_monoid_hom.completion (f : α →+ β) (hf : continuous f) : completion α →+ completion β :=
(to_compl.comp f).extension (continuous_to_compl.comp hf)

@[continuity]
lemma add_monoid_hom.continuous_completion (f : α →+ β)
  (hf : continuous f) : continuous (f.completion hf : completion α → completion β) :=
continuous_map

lemma add_monoid_hom.completion_coe (f : α →+ β)
  (hf : continuous f) (a : α) : f.completion hf a = f a :=
map_coe (uniform_continuous_add_monoid_hom_of_continuous hf) a

lemma add_monoid_hom.completion_zero : (0 : α →+ β).completion continuous_const = 0 :=
begin
  ext x,
  apply completion.induction_on x,
  { apply is_closed_eq ((0 : α →+ β).continuous_completion continuous_const),
    simp [continuous_const] },
  { intro a,
    simp [(0 : α →+ β).completion_coe continuous_const, coe_zero] }
end

lemma add_monoid_hom.completion_add {γ : Type*} [add_comm_group γ] [uniform_space γ]
  [uniform_add_group γ] (f g : α →+ γ) (hf : continuous f) (hg : continuous g) :
  (f + g).completion (hf.add hg) = f.completion hf + g.completion hg :=
begin
  have hfg := hf.add hg,
  ext x,
  apply completion.induction_on x,
  { exact is_closed_eq ((f+g).continuous_completion hfg)
    ((f.continuous_completion hf).add (g.continuous_completion hg)) },
  { intro a,
    simp [(f+g).completion_coe hfg, coe_add, f.completion_coe hf, g.completion_coe hg] }
end

end add_monoid_hom


import ring_theory.matrix
import .row_equivalence

universes u
variables {m n : ℕ}
variable {α : Type u}
variable [division_ring α]
variable [decidable_eq α]

def ge_aux_findpivot : (fin m) → (fin m) → (fin n) → (matrix (fin m) (fin n) α) → (matrix (fin m) (fin n) α)
| ⟨0, h₁⟩        i₀ j₀ M := M
| ⟨(k + 1), h₁⟩ i₀ j₀ M :=
        if k ≥ i₀.val then
            if M ⟨k+1, h₁⟩ j₀ ≠ 0
                then matrix.mul (elementary.swap α ⟨k+1, h₁⟩ i₀).to_matrix M
            else ge_aux_findpivot ⟨k, nat.lt_of_succ_lt h₁⟩ i₀ j₀ M
        else M

def ge_aux_improvepivot : (fin m) → (fin n) → (matrix (fin m) (fin n) α) → (matrix (fin m) (fin n) α) :=
λ i₀ j₀ M, if h : M i₀ j₀ ≠ 0
    then matrix.mul (elementary.scale i₀ ((M i₀ j₀)⁻¹) (inv_ne_zero h)).to_matrix M
    else M

def ge_aux_eliminate : Π (k : fin m) (i : fin m) (j : fin n) (M : matrix (fin m) (fin n) α) (h : M i j = 1), (matrix (fin m) (fin n) α) :=
λ k i j M h, if h₀ : k≠i then matrix.mul (elementary.linear_add k (-(M k j)) i h₀).to_matrix M else M

def ge_aux_eliminatecolumn : Π (k : fin m) (i : fin m) (j : fin n) (M : matrix (fin m) (fin n) α), (matrix (fin m) (fin n) α)
| ⟨0,h₁⟩ i j M := M
| ⟨k+1, h₁⟩ i j M := begin
    from if h : k < i.val then M else begin
        apply ge_aux_eliminatecolumn ⟨k, nat.lt_of_succ_lt h₁⟩ i j _ ,
        -- show matrix (fin m) (fin n) α,
        -- clear ge_aux_eliminatecolumn,
        -- cases n,
        -- exfalso,
        -- from nat.not_lt_zero j.val j.is_lt,
        -- cases m,
        -- exfalso,
        -- from nat.not_lt_zero i.val i.is_lt,
        -- have h₂, from (iff.elim_left nat.lt_iff_le_not_le),
        have h_ne : fin.mk (k+1) h₁ ≠ i,
        intros h_eq,
        apply h,
        cases h_eq,
        simp[nat.lt_succ_self 0],

        from matrix.mul (elementary.linear_add ⟨k+1, h₁⟩ (-(M ⟨k+1,h₁⟩ j)) i h_ne).to_matrix M,
        end
end

inductive row_reduction_step : (fin m) → (fin n) → matrix (fin m) (fin n) α → matrix (fin m) (fin n) α → Type u
| findpivot : Π (i : fin m) (j : fin n) (M : matrix (fin m) (fin n) α) (i₀ : fin m), row_reduction_step i j M (ge_aux_findpivot i₀ i j M)
| improvepivot : Π (i : fin m) (j : fin n) (M : matrix (fin m) (fin n) α), row_reduction_step i j M (ge_aux_improvepivot i j M)
| eliminate : Π (i : fin m) (j : fin n) (M : matrix (fin m) (fin n) α) (i₀ : fin m) (h : M i j = 1), row_reduction_step i j M (ge_aux_eliminate i₀ i j M h)

def ge_aux_findpivot_row_equivalent : Π (i : fin m) (i₀ : fin m) (j₀ : fin n) (M : matrix (fin m) (fin n) α), row_equivalent M (ge_aux_findpivot i i₀ j₀ M)
| ⟨0, h₀⟩   i₀ j₀ M :=
begin
    simp[ge_aux_findpivot],
    from row_equivalent.nil,
end
| ⟨k+1, h₀⟩ i₀ j₀ M := begin
    unfold ge_aux_findpivot,
    split_ifs,
    from @row_equivalent_step.of_elementary m n α _ _ M (elementary.swap α ⟨k + 1, h₀⟩ i₀),
    apply ge_aux_findpivot_row_equivalent,
    from row_equivalent.nil,
end

-- set_option pp.proofs true

def ge_aux_improvepivot_row_equivalent : Π (i₀ : fin m) (j₀ : fin n) (M : matrix (fin m) (fin n) α), row_equivalent M (ge_aux_improvepivot i₀ j₀ M)
| i₀ j₀ M :=
begin
    simp[ge_aux_improvepivot],
    split_ifs,
    from @row_equivalent_step.of_elementary m n α _ _ M (elementary.scale i₀ (M i₀ j₀)⁻¹ (ge_aux_improvepivot._proof_1 i₀ j₀ M h)),
    from row_equivalent.nil
end

def ge_aux_eliminate_row_equivalent : Π (i : fin m) (i₀ : fin m) (j₀ : fin n) (M : matrix (fin m) (fin n) α) (h : M i₀ j₀ = 1), row_equivalent M (ge_aux_eliminate i i₀ j₀ M h)
| i i₀ j₀ M h :=
begin
    unfold ge_aux_eliminate,
    split_ifs,
    from @row_equivalent_step.of_elementary m n α _ _ M (elementary.linear_add i (-M i j₀) i₀ h_1),
    from row_equivalent.nil,
end

def ge_aux_eliminatecolumn_row_equivalent : Π (i : fin m) (i₀ : fin m) (j₀ : fin n) (M : matrix (fin m) (fin n) α), row_equivalent M (ge_aux_eliminatecolumn i i₀ j₀ M)
| ⟨0, h₀⟩ i₀ j₀ M :=
begin
    unfold ge_aux_eliminatecolumn,
    from row_equivalent.nil,
end
| ⟨k+1, h₀⟩ i₀ j₀ M :=
begin
    unfold ge_aux_eliminatecolumn,
    split_ifs,
    from row_equivalent.nil,
    apply row_equivalent.trans,
    show matrix (fin m) (fin n) α,
    from (matrix.mul
          (elementary.to_matrix
             (elementary.linear_add ⟨k + 1, h₀⟩ (-M ⟨k + 1, h₀⟩ j₀) i₀
                (ge_aux_eliminatecolumn._main._pack._proof_1 k h₀ i₀ h)))
          M),
    from @row_equivalent_step.of_elementary m n α _ _ M (elementary.linear_add ⟨k + 1, h₀⟩ (-M ⟨k + 1, h₀⟩ j₀) i₀
             (ge_aux_eliminatecolumn._main._pack._proof_1 k h₀ i₀ h)),
    apply ge_aux_eliminatecolumn_row_equivalent,
end

-- TODO: Why does bytecode generation fail?
-- def row_reduction_step.to_row_equivalent : Π {j : fin n} {i : fin m} {M N :  matrix (fin m) (fin n) α} (r : row_reduction_step i j M N), row_equivalent M N :=
-- begin
--     intros _ _ _ _ r,
--     induction r with i j M i₀ i j M i j M i₀ h,
--     from @ge_aux_findpivot_row_equivalent m n α _ _ i₀ i j M,
--     from @ge_aux_improvepivot_row_equivalent m n α _ _ i j M,
--     from @ge_aux_eliminate_row_equivalent m n α _ _ i₀ i j M h,
-- end

-- Note that bytecode generation fails even more seriously here! (Because they choose a red underline?)
-- def to_row_equivalent : Π {j : fin n} {i : fin m} {M N :  matrix (fin m) (fin n) α} (r : row_reduction_step i j M N), row_equivalent M N
-- | _ _ _ _ (row_reduction_step.findpivot i j M i₀) :=  @ge_aux_findpivot_row_equivalent m n α _ _ i₀ i j M
-- | _ _ _ _ (row_reduction_step.improvepivot i j M) :=  @ge_aux_improvepivot_row_equivalent m n α _ _ i j M
-- | _ _ _ _ (row_reduction_step.eliminate i j M i₀ h) := @ge_aux_eliminate_row_equivalent m n α _ _ i₀ i j M h

lemma nat.sub_lt_succ_of_lt_succ {a b : ℕ} : a < (nat.succ b) → b - a < (nat.succ b) :=
begin
    intro h,
    cases a,
    from nat.lt_succ_self b,
    from nat.lt_trans ((nat.sub_lt_of_pos_le (nat.succ a) b (nat.zero_lt_succ a)) (nat.le_of_lt_succ h)) (nat.lt_succ_self b),
end

@[simp] lemma nat.pred_lt_of_ne_zero {n : ℕ} : n ≠ 0 → nat.succ (nat.pred n) = n :=
begin
    intros h_nz,
    apply nat.succ_pred_eq_of_pos,
    have H₁, from @nat.eq_or_lt_of_le 0 n (nat.zero_le n),
    cases H₁,
    exfalso,
    from h_nz (eq.symm H₁),
    assumption,
end

lemma nat.pred_sub_lt {a b : ℕ} : b ≠ 0 → a < b → (nat.pred b) - a < b :=
begin
    intros h_n h,
    rw ←nat.pred_lt_of_ne_zero h_n,
    apply nat.sub_lt_succ_of_lt_succ,
    simp[nat.pred_lt_of_ne_zero h_n],
    from h,
end

lemma nat.lt_succ_of_succ_lt {a b : ℕ} : nat.succ a < b → a < nat.succ b :=
begin
    intros h,
    have ha, from nat.lt_succ_self a,
    have hb, from nat.lt_succ_self b,
    apply nat.lt_trans ha,
    apply nat.lt_trans,
    swap,
    from hb,
    from h
end

lemma nat.pred_pred_sub_lt_of_lt : Π {a b : ℕ}, nat.succ a < b → (nat.pred b) - a - 1 < b :=
begin
    intros a b h,
    have H₁, from @nat.sub_lt_succ_of_lt_succ (nat.succ a) (nat.pred b),
    rw nat.pred_lt_of_ne_zero at H₁,
    have H₂,
    from H₁ h,
    have H₃ : nat.pred b - nat.succ a = nat.pred b - a - 1,
    refl,
    rw ←H₃,
    from H₂,

    intros h₁,
    have H₂, from @nat.zero_lt_succ a,
    have H₃, from nat.lt_trans H₂ h,
    subst h₁,
    from nat.not_lt_zero 0 H₃,
end

lemma nat.lt_succ_pred : Π {n : ℕ}, (n ≠ 0) → (nat.pred n) < n :=
begin
    intros n h,
    have : (nat.pred n < nat.succ (nat.pred n)) = (nat.pred n < n),
    congr,
    from nat.pred_lt_of_ne_zero h,
    rw ←this,
    from nat.lt_succ_self (nat.pred n),
end

def ge_aux : Π (j : fin n) (i : fin m) (h_n : n ≠ 0) (h_m : m ≠ 0) (M : matrix (fin m) (fin n) α), (matrix (fin m) (fin n) α)
|     ⟨k₂, h₂⟩  ⟨0, h₁⟩  h_n h_m    M       :=
        begin  -- If we're on the last row, all we need to do is improve the pivot if we can
            from if M ⟨0, h₁⟩ ⟨k₂, h₂⟩ ≠ 0 then
                begin
                    apply ge_aux_improvepivot,
                    from ⟨nat.pred m, nat.pred_lt h_m⟩,

                    from ⟨(nat.pred n) - k₂, nat.pred_sub_lt h_n h₂⟩,
                    from M,
                end
            else M,
        end
|  ⟨0, h₂⟩  ⟨k₁+1, h₁⟩ h_n h_m   M    :=
        begin  -- If we're in the last column, all we need to do is eliminate that column

            -- have H₁, from @nat.sub_lt_succ_of_lt_succ k₁ (nat.pred m) (nat.lt_of_succ_lt h₁),
            let toplefti : fin m := ⟨(nat.pred m)-k₁-1, nat.pred_pred_sub_lt_of_lt h₁⟩,
            let topleftj : fin n := ⟨nat.pred n, nat.pred_lt h_n⟩,

            let bottomrow : fin m := ⟨nat.pred m, nat.pred_lt h_m⟩,

            have M₁ : matrix (fin m) (fin n) α,
            apply ge_aux_findpivot bottomrow toplefti topleftj M,

            from if H₁ : (M₁ toplefti topleftj ≠ 0) then begin
                apply ge_aux_eliminatecolumn,
                from bottomrow,
                from toplefti,
                from topleftj,

                apply ge_aux_improvepivot,
                from toplefti,
                from topleftj,

                from M₁,
                repeat {assumption},
            end else M₁,
        end
| ⟨k₂+1, h₂⟩  ⟨k₁+1, h₁⟩ h_n h_m  M   :=
        begin
            apply ge_aux,
            show matrix (fin m) (fin n) α,

            let toplefti : (fin m) := ⟨(nat.pred m)-k₁-1, nat.pred_pred_sub_lt_of_lt h₁⟩,
            let topleftj : (fin n) := ⟨(nat.pred n)-k₂-1, nat.pred_pred_sub_lt_of_lt h₂⟩,

            let bottomrow : fin (m) := ⟨nat.pred m, nat.pred_lt h_m⟩,

            have M₁ : matrix (fin m) (fin n) α,
            from ge_aux_findpivot bottomrow toplefti topleftj M,

            from if H₁ : (M₁ toplefti topleftj ≠ 0) then begin
                apply ge_aux_eliminatecolumn,
                from bottomrow,
                from toplefti,
                from topleftj,

                -- show matrix _ _ α,
                apply ge_aux_improvepivot,
                from toplefti,
                from topleftj,

                from M₁,
                repeat {assumption},
            end else M₁,

            from ⟨k₂, nat.lt_of_succ_lt h₂⟩,

            let toplefti : fin m := ⟨(nat.pred m)-k₁-1, nat.pred_pred_sub_lt_of_lt h₁⟩,
            let topleftj : fin n := ⟨(nat.pred n)-k₂-1, nat.pred_pred_sub_lt_of_lt h₂⟩,

            let bottomrow : fin m := ⟨nat.pred m, nat.pred_lt h_m⟩,

            have M₁ : matrix (fin m) (fin n) α,
            from ge_aux_findpivot bottomrow toplefti topleftj M,

            from if H₁ : (M₁ toplefti topleftj ≠ 0)
            then ⟨k₁, nat.lt_of_succ_lt h₁⟩
            else ⟨k₁+1, h₁⟩,
            from h_n,
            from h_m,
        end

def gaussian_elimination : Π {m n : ℕ}, matrix (fin m) (fin n) α → matrix (fin m) (fin n) α
| 0 _ M := M
| _ 0 M := M
| (m+1) (n+1) M :=
begin
refine ge_aux ⟨ n, nat.lt_succ_self _ ⟩ ⟨ m, nat.lt_succ_self _ ⟩ _ _ M,
sorry, sorry
end

-- def gaussian_elimination (M : matrix (fin m) (fin n) α) : matrix (fin m) (fin n) α :=
-- begin
--     by_cases h_m : m = 0,
--     from M,
--     by_cases h_n : n = 0,
--     from M,

--     have h₁, from nat.pred_lt_of_ne_zero h_m,
--     have h₂, from nat.pred_lt_of_ne_zero h_n,

--     apply ge_aux,
--     from ⟨nat.pred n, nat.lt_succ_pred h_n⟩,
--     from ⟨nat.pred m, nat.lt_succ_pred h_m⟩,
--     from h_n,
--     from h_m,
--     from M,
-- end

def ge_aux_row_equivalent : Π (j : fin n) (i : fin m) (h_n : n ≠ 0) (h_m : m ≠ 0) (M : matrix (fin m) (fin n) α), row_equivalent M (ge_aux j i h_n h_m M)
| ⟨0, j_is_lt⟩ ⟨0, i_is_lt⟩ h_n h_m M :=
begin
    simp[ge_aux],
    split_ifs,
    from row_equivalent.nil,
    apply row_equivalent.trans,

    swap,
    apply ge_aux_improvepivot_row_equivalent,
    from row_equivalent.nil,
end
| ⟨j+1, j_is_lt⟩ ⟨0, i_is_lt⟩ h_n h_m M :=
begin
    simp[ge_aux],
    split_ifs,
    from row_equivalent.nil,

    apply row_equivalent.trans,
    swap,
    apply ge_aux_improvepivot_row_equivalent,
    from row_equivalent.nil,
end
| ⟨0, j_is_lt⟩ ⟨i+1, i_is_lt⟩ h_n h_m M :=
begin
    simp[ge_aux],
    split_ifs,
    apply ge_aux_findpivot_row_equivalent,

    apply row_equivalent.trans,
    show row_equivalent M (ge_aux_findpivot ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n, _⟩ M),
    apply ge_aux_findpivot_row_equivalent,
    apply row_equivalent.trans,
    show row_equivalent _ (ge_aux_improvepivot ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n, _⟩
          (ge_aux_findpivot ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n, _⟩ M)),
    apply ge_aux_improvepivot_row_equivalent,
    apply ge_aux_eliminatecolumn_row_equivalent,
end
| ⟨j + 1, j_is_lt⟩ ⟨i + 1, i_is_lt⟩ h_n h_m M :=
begin
    simp[ge_aux],
    split_ifs,
    apply row_equivalent.trans,
    swap,
    apply ge_aux_row_equivalent,
    apply ge_aux_findpivot_row_equivalent,

    apply row_equivalent.trans,
    show row_equivalent M (ge_aux_findpivot ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩ M),
    apply ge_aux_findpivot_row_equivalent,
    apply row_equivalent.trans,
    show row_equivalent _  (ge_aux_improvepivot ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩
             (ge_aux_findpivot ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩ M)),
    apply ge_aux_improvepivot_row_equivalent,
    apply row_equivalent.trans,
    show row_equivalent _ (ge_aux_eliminatecolumn ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩
          (ge_aux_improvepivot ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩
             (ge_aux_findpivot ⟨nat.pred m, _⟩ ⟨nat.pred m - i - 1, _⟩ ⟨nat.pred n - j - 1, _⟩ M))),
    apply ge_aux_eliminatecolumn_row_equivalent,
    apply ge_aux_row_equivalent,
end

def gaussian_elimination.row_equivalent : Π (M : matrix (fin m) (fin n) α), row_equivalent M (gaussian_elimination M) :=
begin
    intros,
    cases m;cases n;
    simp[gaussian_elimination],
    from row_equivalent.nil,
    from row_equivalent.nil,
    from row_equivalent.nil,
    apply ge_aux_row_equivalent,
end


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module algebra.order.positive.ring
! leanprover-community/mathlib commit 655994e298904d7e5bbd1e18c95defd7b543eb94
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Algebra.Ring.InjSurj

/-!
# Algebraic structures on the set of positive numbers

In this file we define various instances (`AddSemigroup`, `OrderedCommMonoid` etc) on the
type `{x : R // 0 < x}`. In each case we try to require the weakest possible typeclass
assumptions on `R` but possibly, there is a room for improvements.
-/

open Function

namespace Positive

variable {M R K : Type _}

section AddBasic

variable [AddMonoid M] [Preorder M] [CovariantClass M M (· + ·) (· < ·)]

instance : Add { x : M // 0 < x } :=
  ⟨fun x y => ⟨x + y, add_pos x.2 y.2⟩⟩

@[simp, norm_cast]
theorem coe_add (x y : { x : M // 0 < x }) : ↑(x + y) = (x + y : M) :=
  rfl
#align positive.coe_add Positive.coe_add

instance addSemigroup : AddSemigroup { x : M // 0 < x } :=
  Subtype.coe_injective.addSemigroup _ coe_add
#align positive.subtype.add_semigroup Positive.addSemigroup

instance addCommSemigroup {M : Type _} [AddCommMonoid M] [Preorder M]
    [CovariantClass M M (· + ·) (· < ·)] : AddCommSemigroup { x : M // 0 < x } :=
  Subtype.coe_injective.addCommSemigroup _ coe_add
#align positive.subtype.add_comm_semigroup Positive.addCommSemigroup

instance addLeftCancelSemigroup {M : Type _} [AddLeftCancelMonoid M] [Preorder M]
    [CovariantClass M M (· + ·) (· < ·)] : AddLeftCancelSemigroup { x : M // 0 < x } :=
  Subtype.coe_injective.addLeftCancelSemigroup _ coe_add
#align positive.subtype.add_left_cancel_semigroup Positive.addLeftCancelSemigroup

instance addRightCancelSemigroup {M : Type _} [AddRightCancelMonoid M] [Preorder M]
    [CovariantClass M M (· + ·) (· < ·)] : AddRightCancelSemigroup { x : M // 0 < x } :=
  Subtype.coe_injective.addRightCancelSemigroup _ coe_add
#align positive.subtype.add_right_cancel_semigroup Positive.addRightCancelSemigroup

instance covariantClass_add_lt :
    CovariantClass { x : M // 0 < x } { x : M // 0 < x } (· + ·) (· < ·) :=
  ⟨fun _ y z hyz => Subtype.coe_lt_coe.1 <| add_lt_add_left (show (y : M) < z from hyz) _⟩
#align positive.covariant_class_add_lt Positive.covariantClass_add_lt

instance covariantClass_swap_add_lt [CovariantClass M M (swap (· + ·)) (· < ·)] :
    CovariantClass { x : M // 0 < x } { x : M // 0 < x } (swap (· + ·)) (· < ·) :=
  ⟨fun _ y z hyz => Subtype.coe_lt_coe.1 <| add_lt_add_right (show (y : M) < z from hyz) _⟩
#align positive.covariant_class_swap_add_lt Positive.covariantClass_swap_add_lt

instance contravariantClass_add_lt [ContravariantClass M M (· + ·) (· < ·)] :
    ContravariantClass { x : M // 0 < x } { x : M // 0 < x } (· + ·) (· < ·) :=
  ⟨fun _ _ _ h => Subtype.coe_lt_coe.1 <| lt_of_add_lt_add_left h⟩
#align positive.contravariant_class_add_lt Positive.contravariantClass_add_lt

instance contravariantClass_swap_add_lt [ContravariantClass M M (swap (· + ·)) (· < ·)] :
    ContravariantClass { x : M // 0 < x } { x : M // 0 < x } (swap (· + ·)) (· < ·) :=
  ⟨fun _ _ _ h => Subtype.coe_lt_coe.1 <| lt_of_add_lt_add_right h⟩
#align positive.contravariant_class_swap_add_lt Positive.contravariantClass_swap_add_lt

instance contravariantClass_add_le [ContravariantClass M M (· + ·) (· ≤ ·)] :
    ContravariantClass { x : M // 0 < x } { x : M // 0 < x } (· + ·) (· ≤ ·) :=
  ⟨fun _ _ _ h => Subtype.coe_le_coe.1 <| le_of_add_le_add_left h⟩
#align positive.contravariant_class_add_le Positive.contravariantClass_add_le

instance contravariantClass_swap_add_le [ContravariantClass M M (swap (· + ·)) (· ≤ ·)] :
    ContravariantClass { x : M // 0 < x } { x : M // 0 < x } (swap (· + ·)) (· ≤ ·) :=
  ⟨fun _ _ _ h => Subtype.coe_le_coe.1 <| le_of_add_le_add_right h⟩
#align positive.contravariant_class_swap_add_le Positive.contravariantClass_swap_add_le

end AddBasic

instance covariantClass_add_le [AddMonoid M] [PartialOrder M]
    [CovariantClass M M (· + ·) (· < ·)] :
    CovariantClass { x : M // 0 < x } { x : M // 0 < x } (· + ·) (· ≤ ·) :=
  ⟨@fun _ _ _ h₁ => StrictMono.monotone (fun _ _ h => add_lt_add_left h _) h₁⟩
#align positive.covariant_class_add_le Positive.covariantClass_add_le

section Mul

variable [StrictOrderedSemiring R]

instance : Mul { x : R // 0 < x } :=
  ⟨fun x y => ⟨x * y, mul_pos x.2 y.2⟩⟩

@[simp]
theorem val_mul (x y : { x : R // 0 < x }) : ↑(x * y) = (x * y : R) :=
  rfl
#align positive.coe_mul Positive.val_mul

instance : Pow { x : R // 0 < x } ℕ :=
  ⟨fun x n => ⟨(x : R) ^ n , pow_pos x.2 n⟩⟩

@[simp]
theorem val_pow (x : { x : R // 0 < x }) (n : ℕ) :
    (x ^ n : R) = (x : R) ^ n :=
  rfl
#align positive.coe_pow Positive.val_pow

instance : Semigroup { x : R // 0 < x } :=
  Subtype.coe_injective.semigroup Subtype.val val_mul

instance : Distrib { x : R // 0 < x } :=
  Subtype.coe_injective.distrib _ coe_add val_mul

instance [Nontrivial R] : One { x : R // 0 < x } :=
  ⟨⟨1, one_pos⟩⟩

@[simp]
theorem val_one [Nontrivial R] : ((1 : { x : R // 0 < x }) : R) = 1 :=
  rfl
#align positive.coe_one Positive.val_one

instance [Nontrivial R] : Monoid { x : R // 0 < x } :=
  Subtype.coe_injective.monoid _ val_one val_mul val_pow

end Mul

section mul_comm

instance orderedCommMonoid [StrictOrderedCommSemiring R] [Nontrivial R] :
    OrderedCommMonoid { x : R // 0 < x } :=
  { Subtype.partialOrder _,
    Subtype.coe_injective.commMonoid (M₂ := R) (Subtype.val) val_one val_mul val_pow with
    mul_le_mul_left := fun _ _ hxy c =>
      Subtype.coe_le_coe.1 <| mul_le_mul_of_nonneg_left hxy c.2.le }
#align positive.subtype.ordered_comm_monoid Positive.orderedCommMonoid

/-- If `R` is a nontrivial linear ordered commutative semiring, then `{x : R // 0 < x}` is a linear
ordered cancellative commutative monoid. -/
instance linearOrderedCancelCommMonoid [LinearOrderedCommSemiring R] :
    LinearOrderedCancelCommMonoid { x : R // 0 < x } :=
  { Subtype.linearOrder _, Positive.orderedCommMonoid with
    le_of_mul_le_mul_left := fun a _ _ h => Subtype.coe_le_coe.1 <| (mul_le_mul_left a.2).1 h }
#align positive.subtype.linear_ordered_cancel_comm_monoid Positive.linearOrderedCancelCommMonoid

end mul_comm

end Positive


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.direct_sum.basic
import linear_algebra.dfinsupp

/-!
# Direct sum of modules

The first part of the file provides constructors for direct sums of modules. It provides a
construction of the direct sum using the universal property and proves its uniqueness
(`direct_sum.to_module.unique`).

The second part of the file covers the special case of direct sums of submodules of a fixed module
`M`.  There is a canonical linear map from this direct sum to `M` (`direct_sum.coe_linear_map`), and
the construction is of particular importance when this linear map is an equivalence; that is, when
the submodules provide an internal decomposition of `M`.  The property is defined more generally
elsewhere as `direct_sum.is_internal`, but its basic consequences on `submodule`s are established
in this file.

-/

universes u v w u₁

namespace direct_sum
open_locale direct_sum

section general
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include R
variables {M : ι → Type w} [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]

instance : module R (⨁ i, M i) := dfinsupp.module
instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] :
  smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class
instance {S : Type*} [semiring S] [has_scalar R S] [Π i, module S (M i)]
  [Π i, is_scalar_tower R S (M i)] :
  is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower
instance [Π i, module Rᵐᵒᵖ (M i)] [Π i, is_central_scalar R (M i)] :
  is_central_scalar R (⨁ i, M i) := dfinsupp.is_central_scalar

lemma smul_apply (b : R) (v : ⨁ i, M i) (i : ι) :
  (b • v) i = b • (v i) := dfinsupp.smul_apply _ _ _

include dec_ι

variables R ι M
/-- Create the direct sum given a family `M` of `R` modules indexed over `ι`. -/
def lmk : Π s : finset ι, (Π i : (↑s : set ι), M i.val) →ₗ[R] (⨁ i, M i) :=
dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof : Π i : ι, M i →ₗ[R] (⨁ i, M i) :=
dfinsupp.lsingle

variables {ι M}

lemma single_eq_lof (i : ι) (b : M i) :
  dfinsupp.single i b = lof R ι M i b := rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (s : finset ι) (c : R) (x) : mk M s (c • x) = c • mk M s x :=
(lmk R ι M s).map_smul c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (i : ι) (c : R) (x) : of M i (c • x) = c • of M i x :=
(lof R ι M i).map_smul c x

variables {R}
lemma support_smul [Π (i : ι) (x : M i), decidable (x ≠ 0)]
  (c : R) (v : ⨁ i, M i) : (c • v).support ⊆ v.support := dfinsupp.support_smul _ _

variables {N : Type u₁} [add_comm_monoid N] [module R N]
variables (φ : Π i, M i →ₗ[R] N)

variables (R ι N φ)
/-- The linear map constructed using the universal property of the coproduct. -/
def to_module : (⨁ i, M i) →ₗ[R] N :=
dfinsupp.lsum ℕ φ

/-- Coproducts in the categories of modules and additive monoids commute with the forgetful functor
from modules to additive monoids. -/
lemma coe_to_module_eq_coe_to_add_monoid :
  (to_module R ι N φ : (⨁ i, M i) → N) = to_add_monoid (λ i, (φ i).to_add_monoid_hom) :=
rfl

variables {ι N φ}

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] lemma to_module_lof (i) (x : M i) : to_module R ι N φ (lof R ι M i x) = φ i x :=
to_add_monoid_of (λ i, (φ i).to_add_monoid_hom) i x

variables (ψ : (⨁ i, M i) →ₗ[R] N)

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (f : ⨁ i, M i) : ψ f = to_module R ι N (λ i, ψ.comp $ lof R ι M i) f :=
to_add_monoid.unique ψ.to_add_monoid_hom f

variables {ψ} {ψ' : (⨁ i, M i) →ₗ[R] N}

/-- Two `linear_map`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem linear_map_ext ⦃ψ ψ' : (⨁ i, M i) →ₗ[R] N⦄
  (H : ∀ i, ψ.comp (lof R ι M i) = ψ'.comp (lof R ι M i)) : ψ = ψ' :=
dfinsupp.lhom_ext' H

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), M i) →ₗ[R] (⨁ (i : T), M i) :=
to_module R _ _ $ λ i, lof R T (λ (i : subtype T), M i) ⟨i, H i.prop⟩

omit dec_ι

variables (ι M)
/-- Given `fintype α`, `linear_equiv_fun_on_fintype R` is the natural `R`-linear equivalence
between `⨁ i, M i` and `Π i, M i`. -/
@[simps apply] def linear_equiv_fun_on_fintype [fintype ι] :
  (⨁ i, M i) ≃ₗ[R] (Π i, M i) :=
{ to_fun := coe_fn,
  map_add' := λ f g, by { ext, simp only [add_apply, pi.add_apply] },
  map_smul' := λ c f, by { ext, simp only [dfinsupp.coe_smul, ring_hom.id_apply] },
  .. dfinsupp.equiv_fun_on_fintype }

variables {ι M}
@[simp] lemma linear_equiv_fun_on_fintype_lof [fintype ι] [decidable_eq ι] (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M) (lof R ι M i m) = pi.single i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype (lof R ι M i m)) a = _,
  convert _root_.congr_fun (dfinsupp.equiv_fun_on_fintype_single i m) a,
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_single [fintype ι] [decidable_eq ι]
  (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M).symm (pi.single i m) = lof R ι M i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype.symm (pi.single i m)) a = _,
  rw (dfinsupp.equiv_fun_on_fintype_symm_single i m),
  refl
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_coe [fintype ι] (f : ⨁ i, M i) :
  (linear_equiv_fun_on_fintype R ι M).symm f = f :=
by { ext, simp [linear_equiv_fun_on_fintype], }

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [module R M]
  [unique ι] :
  (⨁ (_ : ι), M) ≃ₗ[R] M :=
{ .. direct_sum.id M ι,
  .. to_module R ι M (λ i, linear_map.id) }

variables (ι M)
/-- The projection map onto one component, as a linear map. -/
def component (i : ι) : (⨁ i, M i) →ₗ[R] M i :=
dfinsupp.lapply i

variables {ι M}

lemma apply_eq_component (f : ⨁ i, M i) (i : ι) :
  f i = component R ι M i f := rfl

@[ext] lemma ext {f g : ⨁ i, M i}
  (h : ∀ i, component R ι M i f = component R ι M i g) : f = g :=
dfinsupp.ext h

lemma ext_iff {f g : ⨁ i, M i} : f = g ↔
  ∀ i, component R ι M i f = component R ι M i g :=
⟨λ h _, by rw h, ext R⟩

include dec_ι

@[simp] lemma lof_apply (i : ι) (b : M i) : ((lof R ι M i) b) i = b :=
dfinsupp.single_eq_same

@[simp] lemma component.lof_self (i : ι) (b : M i) :
  component R ι M i ((lof R ι M i) b) = b :=
lof_apply R i b

lemma component.of (i j : ι) (b : M j) :
  component R ι M i ((lof R ι M j) b) =
  if h : j = i then eq.rec_on h b else 0 :=
dfinsupp.single_apply

omit dec_ι
section congr_left
variables {κ : Type*}

/--Reindexing terms of a direct sum is linear.-/
def lequiv_congr_left (h : ι ≃ κ) : (⨁ i, M i) ≃ₗ[R] ⨁ k, M (h.symm k) :=
{ map_smul' := dfinsupp.comap_domain'_smul _ _,
  ..equiv_congr_left h }

@[simp] lemma lequiv_congr_left_apply (h : ι ≃ κ) (f : ⨁ i, M i) (k : κ) :
lequiv_congr_left R h f k = f (h.symm k) := equiv_congr_left_apply _ _ _

end congr_left

section sigma
variables {α : ι → Type*} {δ : Π i, α i → Type w}
variables [Π i j, add_comm_monoid (δ i j)] [Π i j, module R (δ i j)]

/--`curry` as a linear map.-/
noncomputable def sigma_lcurry : (⨁ (i : Σ i, _), δ i.1 i.2) →ₗ[R] ⨁ i j, δ i j :=
{ map_smul' := λ r, by convert (@dfinsupp.sigma_curry_smul _ _ _ δ _ _ _ r),
  ..sigma_curry }

@[simp] lemma sigma_lcurry_apply (f : ⨁ (i : Σ i, _), δ i.1 i.2) (i : ι) (j : α i) :
  sigma_lcurry R f i j = f ⟨i, j⟩ := sigma_curry_apply f i j

/--`uncurry` as a linear map.-/
noncomputable def sigma_luncurry : (⨁ i j, δ i j) →ₗ[R] ⨁ (i : Σ i, _), δ i.1 i.2 :=
{ map_smul' := dfinsupp.sigma_uncurry_smul,
  ..sigma_uncurry }

@[simp] lemma sigma_luncurry_apply (f : ⨁ i j, δ i j) (i : ι) (j : α i) :
  sigma_luncurry R f ⟨i, j⟩ = f i j := sigma_uncurry_apply f i j

/--`curry_equiv` as a linear equiv.-/
noncomputable def sigma_lcurry_equiv : (⨁ (i : Σ i, _), δ i.1 i.2) ≃ₗ[R] ⨁ i j, δ i j :=
{ ..sigma_curry_equiv, ..sigma_lcurry R }

end sigma

section option
variables {α : option ι → Type w} [Π i, add_comm_monoid (α i)] [Π i, module R (α i)]
include dec_ι

/--Linear isomorphism obtained by separating the term of index `none` of a direct sum over
`option ι`.-/
@[simps] noncomputable def lequiv_prod_direct_sum : (⨁ i, α i) ≃ₗ[R] α none × ⨁ i, α (some i) :=
{ map_smul' := dfinsupp.equiv_prod_dfinsupp_smul,
  ..add_equiv_prod_direct_sum }

end option

end general

section submodule

section semiring
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_monoid M] [module R M]
variables (A : ι → submodule R M)

/-- The canonical embedding from `⨁ i, A i` to `M`  where `A` is a collection of `submodule R M`
indexed by `ι`. This is `direct_sum.coe_add_monoid_hom` as a `linear_map`. -/
def coe_linear_map : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype)

@[simp] lemma coe_linear_map_of (i : ι) (x : A i) :
  direct_sum.coe_linear_map A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

variables {A}

/-- If a direct sum of submodules is internal then the submodules span the module. -/
lemma is_internal.submodule_supr_eq_top (h : is_internal A) : supr A = ⊤ :=
begin
  rw [submodule.supr_eq_range_dfinsupp_lsum, linear_map.range_eq_top],
  exact function.bijective.surjective h,
end

/-- If a direct sum of submodules is internal then the submodules are independent. -/
lemma is_internal.submodule_independent (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_lsum_injective _ h.injective

/-- Given an internal direct sum decomposition of a module `M`, and a basis for each of the
components of the direct sum, the disjoint union of these bases is a basis for `M`. -/
noncomputable def is_internal.collected_basis
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  basis (Σ i, α i) R M :=
{ repr :=
    (linear_equiv.of_bijective (direct_sum.coe_linear_map A) h.injective h.surjective).symm ≪≫ₗ
      (dfinsupp.map_range.linear_equiv (λ i, (v i).repr)) ≪≫ₗ
      (sigma_finsupp_lequiv_dfinsupp R).symm }

@[simp] lemma is_internal.collected_basis_coe
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  ⇑(h.collected_basis v) = λ a : Σ i, (α i), ↑(v a.1 a.2) :=
begin
  funext a,
  simp only [is_internal.collected_basis, to_module, coe_linear_map,
    add_equiv.to_fun_eq_coe, basis.coe_of_repr, basis.repr_symm_apply, dfinsupp.lsum_apply_apply,
    dfinsupp.map_range.linear_equiv_apply, dfinsupp.map_range.linear_equiv_symm,
    dfinsupp.map_range_single, finsupp.total_single, linear_equiv.of_bijective_apply,
    linear_equiv.symm_symm, linear_equiv.symm_trans_apply, one_smul,
    sigma_finsupp_add_equiv_dfinsupp_apply, sigma_finsupp_equiv_dfinsupp_single,
    sigma_finsupp_lequiv_dfinsupp_apply],
  convert dfinsupp.sum_add_hom_single (λ i, (A i).subtype.to_add_monoid_hom) a.1 (v a.1 a.2),
end

lemma is_internal.collected_basis_mem
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) :
  h.collected_basis v a ∈ A a.1 :=
by simp

/-- When indexed by only two distinct elements, `direct_sum.is_internal` implies
the two submodules are complementary. Over a `ring R`, this is true as an iff, as
`direct_sum.is_internal_iff_is_compl`. --/
lemma is_internal.is_compl {A : ι → submodule R M} {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) (hi : is_internal A) : is_compl (A i) (A j) :=
⟨hi.submodule_independent.pairwise_disjoint _ _ hij, eq.le $ hi.submodule_supr_eq_top.symm.trans $
  by rw [←Sup_pair, supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton]⟩

end semiring

section ring
variables {R : Type u} [ring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_group M] [module R M]

/-- Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma is_internal_submodule_of_independent_of_supr_eq_top {A : ι → submodule R M}
  (hi : complete_lattice.independent A) (hs : supr A = ⊤) : is_internal A :=
⟨hi.dfinsupp_lsum_injective, linear_map.range_eq_top.1 $
  (submodule.supr_eq_range_dfinsupp_lsum _).symm.trans hs⟩

/-- `iff` version of `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top`,
`direct_sum.is_internal.independent`, and `direct_sum.is_internal.supr_eq_top`.
-/
lemma is_internal_submodule_iff_independent_and_supr_eq_top (A : ι → submodule R M) :
    is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ :=
⟨λ i, ⟨i.submodule_independent, i.submodule_supr_eq_top⟩,
 and.rec is_internal_submodule_of_independent_of_supr_eq_top⟩

/-- If a collection of submodules has just two indices, `i` and `j`, then
`direct_sum.is_internal` is equivalent to `is_compl`. -/
lemma is_internal_submodule_iff_is_compl (A : ι → submodule R M) {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) :
  is_internal A ↔ is_compl (A i) (A j) :=
begin
  have : ∀ k, k = i ∨ k = j := λ k, by simpa using set.ext_iff.mp h k,
  rw [is_internal_submodule_iff_independent_and_supr_eq_top,
    supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton, Sup_pair,
    complete_lattice.independent_pair hij this],
  exact ⟨λ ⟨hd, ht⟩, ⟨hd, ht.ge⟩, λ ⟨hd, ht⟩, ⟨hd, eq_top_iff.mpr ht⟩⟩,
end

/-! Now copy the lemmas for subgroup and submonoids. -/

lemma is_internal.add_submonoid_independent {M : Type*} [add_comm_monoid M]
  {A : ι → add_submonoid M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective _ h.injective

lemma is_internal.add_subgroup_independent {M : Type*} [add_comm_group M]
  {A : ι → add_subgroup M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' _ h.injective

end ring

end submodule

end direct_sum


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.direct_sum.basic
import linear_algebra.dfinsupp

/-!
# Direct sum of modules

The first part of the file provides constructors for direct sums of modules. It provides a
construction of the direct sum using the universal property and proves its uniqueness
(`direct_sum.to_module.unique`).

The second part of the file covers the special case of direct sums of submodules of a fixed module
`M`.  There is a canonical linear map from this direct sum to `M`, and the construction is
of particular importance when this linear map is an equivalence; that is, when the submodules
provide an internal decomposition of `M`.  The property is defined as
`direct_sum.submodule_is_internal`, and its basic consequences are established.

-/

universes u v w u₁

namespace direct_sum
open_locale direct_sum

section general
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include R
variables {M : ι → Type w} [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]

instance : module R (⨁ i, M i) := dfinsupp.module
instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] :
  smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class
instance {S : Type*} [semiring S] [has_scalar R S] [Π i, module S (M i)]
  [Π i, is_scalar_tower R S (M i)] :
  is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower

lemma smul_apply (b : R) (v : ⨁ i, M i) (i : ι) :
  (b • v) i = b • (v i) := dfinsupp.smul_apply _ _ _

include dec_ι

variables R ι M
/-- Create the direct sum given a family `M` of `R` modules indexed over `ι`. -/
def lmk : Π s : finset ι, (Π i : (↑s : set ι), M i.val) →ₗ[R] (⨁ i, M i) :=
dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof : Π i : ι, M i →ₗ[R] (⨁ i, M i) :=
dfinsupp.lsingle

variables {ι M}

lemma single_eq_lof (i : ι) (b : M i) :
  dfinsupp.single i b = lof R ι M i b := rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (s : finset ι) (c : R) (x) : mk M s (c • x) = c • mk M s x :=
(lmk R ι M s).map_smul c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (i : ι) (c : R) (x) : of M i (c • x) = c • of M i x :=
(lof R ι M i).map_smul c x

variables {R}
lemma support_smul [Π (i : ι) (x : M i), decidable (x ≠ 0)]
  (c : R) (v : ⨁ i, M i) : (c • v).support ⊆ v.support := dfinsupp.support_smul _ _

variables {N : Type u₁} [add_comm_monoid N] [module R N]
variables (φ : Π i, M i →ₗ[R] N)

variables (R ι N φ)
/-- The linear map constructed using the universal property of the coproduct. -/
def to_module : (⨁ i, M i) →ₗ[R] N :=
dfinsupp.lsum ℕ φ

/-- Coproducts in the categories of modules and additive monoids commute with the forgetful functor
from modules to additive monoids. -/
lemma coe_to_module_eq_coe_to_add_monoid :
  (to_module R ι N φ : (⨁ i, M i) → N) = to_add_monoid (λ i, (φ i).to_add_monoid_hom) :=
rfl

variables {ι N φ}

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] lemma to_module_lof (i) (x : M i) : to_module R ι N φ (lof R ι M i x) = φ i x :=
to_add_monoid_of (λ i, (φ i).to_add_monoid_hom) i x

variables (ψ : (⨁ i, M i) →ₗ[R] N)

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (f : ⨁ i, M i) : ψ f = to_module R ι N (λ i, ψ.comp $ lof R ι M i) f :=
to_add_monoid.unique ψ.to_add_monoid_hom f

variables {ψ} {ψ' : (⨁ i, M i) →ₗ[R] N}

/-- Two `linear_map`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem linear_map_ext ⦃ψ ψ' : (⨁ i, M i) →ₗ[R] N⦄
  (H : ∀ i, ψ.comp (lof R ι M i) = ψ'.comp (lof R ι M i)) : ψ = ψ' :=
dfinsupp.lhom_ext' H

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), M i) →ₗ[R] (⨁ (i : T), M i) :=
to_module R _ _ $ λ i, lof R T (λ (i : subtype T), M i) ⟨i, H i.prop⟩

omit dec_ι

variables (ι M)
/-- Given `fintype α`, `linear_equiv_fun_on_fintype R` is the natural `R`-linear equivalence
between `⨁ i, M i` and `Π i, M i`. -/
@[simps apply] def linear_equiv_fun_on_fintype [fintype ι] :
  (⨁ i, M i) ≃ₗ[R] (Π i, M i) :=
{ to_fun := coe_fn,
  map_add' := λ f g, by { ext, simp only [add_apply, pi.add_apply] },
  map_smul' := λ c f, by { ext, simp only [dfinsupp.coe_smul, ring_hom.id_apply] },
  .. dfinsupp.equiv_fun_on_fintype }

variables {ι M}
@[simp] lemma linear_equiv_fun_on_fintype_lof [fintype ι] [decidable_eq ι] (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M) (lof R ι M i m) = pi.single i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype (lof R ι M i m)) a = _,
  convert _root_.congr_fun (dfinsupp.equiv_fun_on_fintype_single i m) a,
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_single [fintype ι] [decidable_eq ι]
  (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M).symm (pi.single i m) = lof R ι M i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype.symm (pi.single i m)) a = _,
  rw (dfinsupp.equiv_fun_on_fintype_symm_single i m),
  refl
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_coe [fintype ι] (f : ⨁ i, M i) :
  (linear_equiv_fun_on_fintype R ι M).symm f = f :=
by { ext, simp [linear_equiv_fun_on_fintype], }

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [module R M]
  [unique ι] :
  (⨁ (_ : ι), M) ≃ₗ[R] M :=
{ .. direct_sum.id M ι,
  .. to_module R ι M (λ i, linear_map.id) }

variables (ι M)
/-- The projection map onto one component, as a linear map. -/
def component (i : ι) : (⨁ i, M i) →ₗ[R] M i :=
dfinsupp.lapply i

variables {ι M}

lemma apply_eq_component (f : ⨁ i, M i) (i : ι) :
  f i = component R ι M i f := rfl

@[ext] lemma ext {f g : ⨁ i, M i}
  (h : ∀ i, component R ι M i f = component R ι M i g) : f = g :=
dfinsupp.ext h

lemma ext_iff {f g : ⨁ i, M i} : f = g ↔
  ∀ i, component R ι M i f = component R ι M i g :=
⟨λ h _, by rw h, ext R⟩

include dec_ι

@[simp] lemma lof_apply (i : ι) (b : M i) : ((lof R ι M i) b) i = b :=
dfinsupp.single_eq_same

@[simp] lemma component.lof_self (i : ι) (b : M i) :
  component R ι M i ((lof R ι M i) b) = b :=
lof_apply R i b

lemma component.of (i j : ι) (b : M j) :
  component R ι M i ((lof R ι M j) b) =
  if h : j = i then eq.rec_on h b else 0 :=
dfinsupp.single_apply

end general

section submodule

section semiring
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_monoid M] [module R M]
variables (A : ι → submodule R M)

/-- The canonical embedding from `⨁ i, A i` to `M`  where `A` is a collection of `submodule R M`
indexed by `ι`-/
def submodule_coe : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype)

@[simp] lemma submodule_coe_of (i : ι) (x : A i) : submodule_coe A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

lemma coe_of_submodule_apply (i j : ι) (x : A i) :
  (direct_sum.of _ i x j : M) = if i = j then x else 0 :=
begin
  obtain rfl | h := decidable.eq_or_ne i j,
  { rw [direct_sum.of_eq_same, if_pos rfl], },
  { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, submodule.coe_zero], },
end

/-- The `direct_sum` formed by a collection of `submodule`s of `M` is said to be internal if the
canonical map `(⨁ i, A i) →ₗ[R] M` is bijective.

For the alternate statement in terms of independence and spanning, see
`direct_sum.submodule_is_internal_iff_independent_and_supr_eq_top`. -/
def submodule_is_internal : Prop := function.bijective (submodule_coe A)

lemma submodule_is_internal.to_add_submonoid :
  submodule_is_internal A ↔ add_submonoid_is_internal (λ i, (A i).to_add_submonoid) :=
iff.rfl

variables {A}

/-- If a direct sum of submodules is internal then the submodules span the module. -/
lemma submodule_is_internal.supr_eq_top (h : submodule_is_internal A) : supr A = ⊤ :=
begin
  rw [submodule.supr_eq_range_dfinsupp_lsum, linear_map.range_eq_top],
  exact function.bijective.surjective h,
end

/-- If a direct sum of submodules is internal then the submodules are independent. -/
lemma submodule_is_internal.independent (h : submodule_is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_lsum_injective _ h.injective

/-- Given an internal direct sum decomposition of a module `M`, and a basis for each of the
components of the direct sum, the disjoint union of these bases is a basis for `M`. -/
noncomputable def submodule_is_internal.collected_basis
  (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  basis (Σ i, α i) R M :=
{ repr := (linear_equiv.of_bijective _ h.injective h.surjective).symm ≪≫ₗ
      (dfinsupp.map_range.linear_equiv (λ i, (v i).repr)) ≪≫ₗ
      (sigma_finsupp_lequiv_dfinsupp R).symm }

@[simp] lemma submodule_is_internal.collected_basis_coe
  (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  ⇑(h.collected_basis v) = λ a : Σ i, (α i), ↑(v a.1 a.2) :=
begin
  funext a,
  simp only [submodule_is_internal.collected_basis, to_module, submodule_coe,
    add_equiv.to_fun_eq_coe, basis.coe_of_repr, basis.repr_symm_apply, dfinsupp.lsum_apply_apply,
    dfinsupp.map_range.linear_equiv_apply, dfinsupp.map_range.linear_equiv_symm,
    dfinsupp.map_range_single, finsupp.total_single, linear_equiv.of_bijective_apply,
    linear_equiv.symm_symm, linear_equiv.symm_trans_apply, one_smul,
    sigma_finsupp_add_equiv_dfinsupp_apply, sigma_finsupp_equiv_dfinsupp_single,
    sigma_finsupp_lequiv_dfinsupp_apply],
  convert dfinsupp.sum_add_hom_single (λ i, (A i).subtype.to_add_monoid_hom) a.1 (v a.1 a.2),
end

lemma submodule_is_internal.collected_basis_mem
  (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) :
  h.collected_basis v a ∈ A a.1 :=
by simp

end semiring

section ring
variables {R : Type u} [ring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_group M] [module R M]

lemma submodule_is_internal.to_add_subgroup (A : ι → submodule R M) :
  submodule_is_internal A ↔ add_subgroup_is_internal (λ i, (A i).to_add_subgroup) :=
iff.rfl

/-- Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma submodule_is_internal_of_independent_of_supr_eq_top {A : ι → submodule R M}
  (hi : complete_lattice.independent A) (hs : supr A = ⊤) : submodule_is_internal A :=
⟨hi.dfinsupp_lsum_injective, linear_map.range_eq_top.1 $
  (submodule.supr_eq_range_dfinsupp_lsum _).symm.trans hs⟩

/-- `iff` version of `direct_sum.submodule_is_internal_of_independent_of_supr_eq_top`,
`direct_sum.submodule_is_internal.independent`, and `direct_sum.submodule_is_internal.supr_eq_top`.
-/
lemma submodule_is_internal_iff_independent_and_supr_eq_top (A : ι → submodule R M) :
    submodule_is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ :=
⟨λ i, ⟨i.independent, i.supr_eq_top⟩,
 and.rec submodule_is_internal_of_independent_of_supr_eq_top⟩

/-! Now copy the lemmas for subgroup and submonoids. -/

lemma add_submonoid_is_internal.independent {M : Type*} [add_comm_monoid M]
  {A : ι → add_submonoid M} (h : add_submonoid_is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective _ h.injective

lemma add_subgroup_is_internal.independent {M : Type*} [add_comm_group M]
  {A : ι → add_subgroup M} (h : add_subgroup_is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' _ h.injective

end ring

end submodule

end direct_sum