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

! This file was ported from Lean 3 source module group_theory.noncomm_pi_coprod
! leanprover-community/mathlib commit 6f9f36364eae3f42368b04858fd66d6d9ae730d8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.OrderOfElement
import Mathlib.Data.Finset.NoncommProd
import Mathlib.Data.Fintype.BigOperators
import Mathlib.Data.Nat.GCD.BigOperators
import Mathlib.Order.SupIndep

/-!
# Canonical homomorphism from a finite family of monoids

This file defines the construction of the canonical homomorphism from a family of monoids.

Given a family of morphisms `ϕ i : N i →* M` for each `i : ι` where elements in the
images of different morphisms commute, we obtain a canonical morphism
`MonoidHom.noncommPiCoprod : (Π i, N i) →* M` that coincides with `ϕ`

## Main definitions

* `MonoidHom.noncommPiCoprod : (Π i, N i) →* M` is the main homomorphism
* `Subgroup.noncommPiCoprod : (Π i, H i) →* G` is the specialization to `H i : Subgroup G`
   and the subgroup embedding.

## Main theorems

* `MonoidHom.noncommPiCoprod` coincides with `ϕ i` when restricted to `N i`
* `MonoidHom.noncommPiCoprod_mrange`: The range of `MonoidHom.noncommPiCoprod` is
  `⨆ (i : ι), (ϕ i).mrange`
* `MonoidHom.noncommPiCoprod_range`: The range of `MonoidHom.noncommPiCoprod` is
  `⨆ (i : ι), (ϕ i).range`
* `Subgroup.noncommPiCoprod_range`: The range of `Subgroup.noncommPiCoprod` is `⨆ (i : ι), H i`.
* `MonoidHom.injective_noncommPiCoprod_of_independent`: in the case of groups, `pi_hom.hom` is
   injective if the `ϕ` are injective and the ranges of the `ϕ` are independent.
* `MonoidHom.independent_range_of_coprime_order`: If the `N i` have coprime orders, then the ranges
   of the `ϕ` are independent.
* `Subgroup.independent_of_coprime_order`: If commuting normal subgroups `H i` have coprime orders,
   they are independent.

-/

open BigOperators

namespace Subgroup

variable {G : Type _} [Group G]

/-- `Finset.noncommProd` is “injective” in `f` if `f` maps into independent subgroups.  This
generalizes (one direction of) `Subgroup.disjoint_iff_mul_eq_one`. -/
@[to_additive "`Finset.noncommSum` is “injective” in `f` if `f` maps into independent subgroups.
This generalizes (one direction of) `AddSubgroup.disjoint_iff_add_eq_zero`. "]
theorem eq_one_of_noncommProd_eq_one_of_independent {ι : Type _} (s : Finset ι) (f : ι → G) (comm)
    (K : ι → Subgroup G) (hind : CompleteLattice.Independent K) (hmem : ∀ x ∈ s, f x ∈ K x)
    (heq1 : s.noncommProd f comm = 1) : ∀ i ∈ s, f i = 1 := by
  classical
    revert heq1
    induction' s using Finset.induction_on with i s hnmem ih
    · simp
    · have hcomm := comm.mono (Finset.coe_subset.2 <| Finset.subset_insert _ _)
      simp only [Finset.forall_mem_insert] at hmem
      have hmem_bsupr : s.noncommProd f hcomm ∈ ⨆ i ∈ (s : Set ι), K i :=
        by
        refine' Subgroup.noncommProd_mem _ _ _
        intro x hx
        have : K x ≤ ⨆ i ∈ (s : Set ι), K i := le_supᵢ₂ (f := fun i _ => K i) x hx
        exact this (hmem.2 x hx)
      intro heq1
      rw [Finset.noncommProd_insert_of_not_mem _ _ _ _ hnmem] at heq1
      have hnmem' : i ∉ (s : Set ι) := by simpa
      obtain ⟨heq1i : f i = 1, heq1S : s.noncommProd f _ = 1⟩ :=
        Subgroup.disjoint_iff_mul_eq_one.mp (hind.disjoint_bsupᵢ hnmem') hmem.1 hmem_bsupr heq1
      intro i h
      simp only [Finset.mem_insert] at h
      rcases h with (rfl | h)
      · exact heq1i
      · refine' ih hcomm hmem.2 heq1S _ h

#align subgroup.eq_one_of_noncomm_prod_eq_one_of_independent Subgroup.eq_one_of_noncommProd_eq_one_of_independent
#align add_subgroup.eq_zero_of_noncomm_sum_eq_zero_of_independent AddSubgroup.eq_zero_of_noncommSum_eq_zero_of_independent

end Subgroup

section FamilyOfMonoids

variable {M : Type _} [Monoid M]

-- We have a family of monoids
-- The fintype assumption is not always used, but declared here, to keep things in order
variable {ι : Type _} [hdec : DecidableEq ι] [Fintype ι]

variable {N : ι → Type _} [∀ i, Monoid (N i)]

-- And morphisms ϕ into G
variable (ϕ : ∀ i : ι, N i →* M)

-- We assume that the elements of different morphism commute
variable (hcomm : Pairwise fun i j => ∀ x y, Commute (ϕ i x) (ϕ j y))

-- We use `f` and `g` to denote elements of `Π (i : ι), N i`
variable (f g : ∀ i : ι, N i)

namespace MonoidHom

/-- The canonical homomorphism from a family of monoids. -/
@[to_additive "The canonical homomorphism from a family of additive monoids. See also
`LinearMap.lsum` for a linear version without the commutativity assumption."]
def noncommPiCoprod : (∀ i : ι, N i) →* M
    where
  toFun f := Finset.univ.noncommProd (fun i => ϕ i (f i)) fun i _ j _ h => hcomm h _ _
  map_one' := by
    apply (Finset.noncommProd_eq_pow_card _ _ _ _ _).trans (one_pow _)
    simp
  map_mul' f g := by
    classical
      simp only
      have := @Finset.noncommProd_mul_distrib _ _ _ Finset.univ (fun i => ϕ i (f i))
        (fun i => ϕ i (g i)) ?_ ?_ ?_
      · convert this
        exact map_mul _ _ _
      · exact fun i _ j _ hij => hcomm hij _ _
      · exact fun i _ j _ hij => hcomm hij _ _
      · exact fun i _ j _ hij => hcomm hij _ _
#align monoid_hom.noncomm_pi_coprod MonoidHom.noncommPiCoprod
#align add_monoid_hom.noncomm_pi_coprod AddMonoidHom.noncommPiCoprod

variable {hcomm}

@[to_additive (attr := simp)]

/-- The universal property of `MonoidHom.noncommPiCoprod` -/
@[to_additive "The universal property of `AddMonoidHom.noncommPiCoprod`"]
def noncommPiCoprodEquiv :
    { ϕ : ∀ i, N i →* M // Pairwise fun i j => ∀ x y, Commute (ϕ i x) (ϕ j y) } ≃ ((∀ i, N i) →* M)
    where
  toFun ϕ := noncommPiCoprod ϕ.1 ϕ.2
  invFun f :=
    ⟨fun i => f.comp (MonoidHom.single N i), fun i j hij x y =>
      Commute.map (Pi.mulSingle_commute hij x y) f⟩
  left_inv ϕ := by
    ext
    simp
  right_inv f := pi_ext fun i x => by simp
#align monoid_hom.noncomm_pi_coprod_equiv MonoidHom.noncommPiCoprodEquiv
#align add_monoid_hom.noncomm_pi_coprod_equiv AddMonoidHom.noncommPiCoprodEquiv

@[to_additive]
theorem noncommPiCoprod_mrange :
    MonoidHom.mrange (noncommPiCoprod ϕ hcomm) = ⨆ i : ι, MonoidHom.mrange (ϕ i) := by
  classical
    apply le_antisymm
    · rintro x ⟨f, rfl⟩
      refine Submonoid.noncommProd_mem _ _ _ (fun _ _ _ _ h => hcomm h _ _) (fun i _ => ?_)
      apply Submonoid.mem_supₛ_of_mem
      · use i
      simp
    · refine' supᵢ_le _
      rintro i x ⟨y, rfl⟩
      refine' ⟨Pi.mulSingle i y, noncommPiCoprod_mulSingle _ _ _⟩
#align monoid_hom.noncomm_pi_coprod_mrange MonoidHom.noncommPiCoprod_mrange
#align add_monoid_hom.noncomm_pi_coprod_mrange AddMonoidHom.noncommPiCoprod_mrange

end MonoidHom

end FamilyOfMonoids

section FamilyOfGroups

variable {G : Type _} [Group G]

variable {ι : Type _} [hdec : DecidableEq ι] [hfin : Fintype ι]

variable {H : ι → Type _} [∀ i, Group (H i)]

variable (ϕ : ∀ i : ι, H i →* G)

variable {hcomm : ∀ i j : ι, i ≠ j → ∀ (x : H i) (y : H j), Commute (ϕ i x) (ϕ j y)}

-- We use `f` and `g` to denote elements of `Π (i : ι), H i`
variable (f g : ∀ i : ι, H i)

namespace MonoidHom

-- The subgroup version of `MonoidHom.noncommPiCoprod_mrange`
@[to_additive]
theorem noncommPiCoprod_range : (noncommPiCoprod ϕ hcomm).range = ⨆ i : ι, (ϕ i).range := by
  classical
    apply le_antisymm
    · rintro x ⟨f, rfl⟩
      refine Subgroup.noncommProd_mem _ (fun _ _ _ _ h => hcomm _ _ h _ _) ?_
      intro i _hi
      apply Subgroup.mem_supₛ_of_mem
      · use i
      simp
    · refine' supᵢ_le _
      rintro i x ⟨y, rfl⟩
      refine' ⟨Pi.mulSingle i y, noncommPiCoprod_mulSingle _ _ _⟩
#align monoid_hom.noncomm_pi_coprod_range MonoidHom.noncommPiCoprod_range
#align add_monoid_hom.noncomm_pi_coprod_range AddMonoidHom.noncommPiCoprod_range

@[to_additive]
theorem injective_noncommPiCoprod_of_independent
    (hind : CompleteLattice.Independent fun i => (ϕ i).range)
    (hinj : ∀ i, Function.Injective (ϕ i)) : Function.Injective (noncommPiCoprod ϕ hcomm) := by
  classical
    apply (MonoidHom.ker_eq_bot_iff _).mp
    apply eq_bot_iff.mpr
    intro f heq1
    have : ∀ i, i ∈ Finset.univ → ϕ i (f i) = 1 :=
      Subgroup.eq_one_of_noncommProd_eq_one_of_independent _ _ (fun _ _ _ _ h => hcomm _ _ h _ _)
        _ hind (by simp) heq1
    ext i
    apply hinj
    simp [this i (Finset.mem_univ i)]
#align monoid_hom.injective_noncomm_pi_coprod_of_independent MonoidHom.injective_noncommPiCoprod_of_independent
#align add_monoid_hom.injective_noncomm_pi_coprod_of_independent AddMonoidHom.injective_noncommPiCoprod_of_independent

variable (hcomm)

@[to_additive]
theorem independent_range_of_coprime_order [Finite ι] [∀ i, Fintype (H i)]
    (hcoprime : ∀ i j, i ≠ j → Nat.coprime (Fintype.card (H i)) (Fintype.card (H j))) :
    CompleteLattice.Independent fun i => (ϕ i).range := by
  cases nonempty_fintype ι
  classical
    rintro i
    rw [disjoint_iff_inf_le]
    rintro f ⟨hxi, hxp⟩
    dsimp at hxi hxp
    rw [supᵢ_subtype', ← noncommPiCoprod_range] at hxp
    rotate_left
    · intro _ _ hj
      apply hcomm
      exact hj ∘ Subtype.ext
    cases' hxp with g hgf
    cases' hxi with g' hg'f
    have hxi : orderOf f ∣ Fintype.card (H i) :=
      by
      rw [← hg'f]
      exact (orderOf_map_dvd _ _).trans orderOf_dvd_card_univ
    have hxp : orderOf f ∣ ∏ j : { j // j ≠ i }, Fintype.card (H j) :=
      by
      rw [← hgf, ← Fintype.card_pi]
      exact (orderOf_map_dvd _ _).trans orderOf_dvd_card_univ
    change f = 1
    rw [← pow_one f, ← orderOf_dvd_iff_pow_eq_one]
    -- porting note: ouch, had to replace an ugly `convert`
    obtain ⟨c, hc⟩ := Nat.dvd_gcd hxp hxi
    use c
    rw [← hc]
    symm
    rw [← Nat.coprime_iff_gcd_eq_one]
    apply Nat.coprime_prod_left
    intro j _
    apply hcoprime
    exact j.2
#align monoid_hom.independent_range_of_coprime_order MonoidHom.independent_range_of_coprime_order
#align add_monoid_hom.independent_range_of_coprime_order AddMonoidHom.independent_range_of_coprime_order

end MonoidHom

end FamilyOfGroups

namespace Subgroup

-- We have an family of subgroups
variable {G : Type _} [Group G]

variable {ι : Type _} [hdec : DecidableEq ι] [hfin : Fintype ι] {H : ι → Subgroup G}

-- Elements of `Π (i : ι), H i` are called `f` and `g` here
variable (f g : ∀ i : ι, H i)

section CommutingSubgroups

-- We assume that the elements of different subgroups commute
variable (hcomm : ∀ i j : ι, i ≠ j → ∀ x y : G, x ∈ H i → y ∈ H j → Commute x y)

@[to_additive]
theorem commute_subtype_of_commute (i j : ι) (hne : i ≠ j) :
    ∀ (x : H i) (y : H j), Commute ((H i).subtype x) ((H j).subtype y) := by
  rintro ⟨x, hx⟩ ⟨y, hy⟩
  exact hcomm i j hne x y hx hy
#align subgroup.commute_subtype_of_commute Subgroup.commute_subtype_of_commute
#align add_subgroup.commute_subtype_of_commute AddSubgroup.commute_subtype_of_commute

/-- The canonical homomorphism from a family of subgroups where elements from different subgroups
commute -/
@[to_additive "The canonical homomorphism from a family of additive subgroups where elements from
different subgroups commute"]
def noncommPiCoprod : (∀ i : ι, H i) →* G :=
  MonoidHom.noncommPiCoprod (fun i => (H i).subtype) (commute_subtype_of_commute hcomm)
#align subgroup.noncomm_pi_coprod Subgroup.noncommPiCoprod
#align add_subgroup.noncomm_pi_coprod AddSubgroup.noncommPiCoprod

variable {hcomm}

@[to_additive (attr := simp)]
theorem noncommPiCoprod_mulSingle (i : ι) (y : H i) :
    noncommPiCoprod hcomm (Pi.mulSingle i y) = y := by apply MonoidHom.noncommPiCoprod_mulSingle
#align subgroup.noncomm_pi_coprod_mul_single Subgroup.noncommPiCoprod_mulSingle
#align add_subgroup.noncomm_pi_coprod_single AddSubgroup.noncommPiCoprod_single

@[to_additive]
theorem noncommPiCoprod_range : (noncommPiCoprod hcomm).range = ⨆ i : ι, H i := by
  simp [noncommPiCoprod, MonoidHom.noncommPiCoprod_range]
#align subgroup.noncomm_pi_coprod_range Subgroup.noncommPiCoprod_range
#align add_subgroup.noncomm_pi_coprod_range AddSubgroup.noncommPiCoprod_range

@[to_additive]
theorem injective_noncommPiCoprod_of_independent (hind : CompleteLattice.Independent H) :
    Function.Injective (noncommPiCoprod hcomm) := by
  apply MonoidHom.injective_noncommPiCoprod_of_independent
  · simpa using hind
  · intro i
    exact Subtype.coe_injective
#align subgroup.injective_noncomm_pi_coprod_of_independent Subgroup.injective_noncommPiCoprod_of_independent
#align add_subgroup.injective_noncomm_pi_coprod_of_independent AddSubgroup.injective_noncommPiCoprod_of_independent

variable (hcomm)

@[to_additive]
theorem independent_of_coprime_order [Finite ι] [∀ i, Fintype (H i)]
    (hcoprime : ∀ i j, i ≠ j → Nat.coprime (Fintype.card (H i)) (Fintype.card (H j))) :
    CompleteLattice.Independent H := by
  simpa using
    MonoidHom.independent_range_of_coprime_order (fun i => (H i).subtype)
      (commute_subtype_of_commute hcomm) hcoprime
#align subgroup.independent_of_coprime_order Subgroup.independent_of_coprime_order
#align add_subgroup.independent_of_coprime_order AddSubgroup.independent_of_coprime_order

end CommutingSubgroups

end Subgroup


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

import data.part
import data.nat.upto
import data.stream.defs

/-!
# Fixed point

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

This module defines a generic `fix` operator for defining recursive
computations that are not necessarily well-founded or productive.
An instance is defined for `part`.

## Main definition

 * class `has_fix`
 * `part.fix`
-/

universes u v

open_locale classical
variables {α : Type*} {β : α → Type*}

/-- `has_fix α` gives us a way to calculate the fixed point
of function of type `α → α`. -/
class has_fix (α : Type*) :=
(fix : (α → α) → α)

namespace part

open part nat nat.upto

section basic

variables (f : (Π a, part $ β a) → (Π a, part $ β a))

/-- A series of successive, finite approximation of the fixed point of `f`, defined by
`approx f n = f^[n] ⊥`. The limit of this chain is the fixed point of `f`. -/
def fix.approx : stream $ Π a, part $ β a
| 0 := ⊥
| (nat.succ i) := f (fix.approx i)

/-- loop body for finding the fixed point of `f` -/
def fix_aux {p : ℕ → Prop} (i : nat.upto p)
  (g : Π j : nat.upto p, i < j → Π a, part $ β a) : Π a, part $ β a :=
f $ λ x : α,
assert (¬p (i.val)) $ λ h : ¬ p (i.val),
g (i.succ h) (nat.lt_succ_self _) x

/-- The least fixed point of `f`.

If `f` is a continuous function (according to complete partial orders),
it satisfies the equations:

  1. `fix f = f (fix f)`          (is a fixed point)
  2. `∀ X, f X ≤ X → fix f ≤ X`   (least fixed point)
-/
protected def fix (x : α) : part $ β x :=
part.assert (∃ i, (fix.approx f i x).dom) $ λ h,
well_founded.fix.{1} (nat.upto.wf h) (fix_aux f) nat.upto.zero x

protected lemma fix_def {x : α} (h' : ∃ i, (fix.approx f i x).dom) :
  part.fix f x = fix.approx f (nat.succ $ nat.find h') x :=
begin
  let p := λ (i : ℕ), (fix.approx f i x).dom,
  have : p (nat.find h') := nat.find_spec h',
  generalize hk : nat.find h' = k,
  replace hk : nat.find h' = k + (@upto.zero p).val := hk,
  rw hk at this,
  revert hk,
  dsimp [part.fix], rw assert_pos h', revert this,
  generalize : upto.zero = z, intros,
  suffices : ∀ x',
    well_founded.fix (fix._proof_1 f x h') (fix_aux f) z x' = fix.approx f (succ k) x',
    from this _,
  induction k generalizing z; intro,
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1, rw assert_neg, refl,
    rw nat.zero_add at this,
    simpa only [not_not, subtype.val_eq_coe] },
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1,
    have hh : ¬(fix.approx f (z.val) x).dom,
    { apply nat.find_min h',
      rw [hk,nat.succ_add,← nat.add_succ],
      apply nat.lt_of_succ_le,
      apply nat.le_add_left },
    rw succ_add_eq_succ_add at this hk,
    rw [assert_pos hh, k_ih (upto.succ z hh) this hk] }
end

end basic

end part

namespace part

instance : has_fix (part α) :=
⟨λ f, part.fix (λ x u, f (x u)) ()⟩

end part

open sigma

namespace pi

instance part.has_fix {β} : has_fix (α → part β) := ⟨part.fix⟩

end pi


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

! This file was ported from Lean 3 source module ring_theory.tensor_product
! leanprover-community/mathlib commit c4926d76bb9c5a4a62ed2f03d998081786132105
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.RingTheory.Adjoin.Basic
import Mathbin.LinearAlgebra.DirectSum.Finsupp

/-!
# The tensor product of R-algebras

Let `R` be a (semi)ring and `A` an `R`-algebra.
In this file we:

- Define the `A`-module structure on `A ⊗ M`, for an `R`-module `M`.
- Define the `R`-algebra structure on `A ⊗ B`, for another `R`-algebra `B`.
  and provide the structure isomorphisms
  * `R ⊗[R] A ≃ₐ[R] A`
  * `A ⊗[R] R ≃ₐ[R] A`
  * `A ⊗[R] B ≃ₐ[R] B ⊗[R] A`
  * `((A ⊗[R] B) ⊗[R] C) ≃ₐ[R] (A ⊗[R] (B ⊗[R] C))`

## Main declaration

- `linear_map.base_change A f` is the `A`-linear map `A ⊗ f`, for an `R`-linear map `f`.

## Implementation notes

The heterobasic definitions below such as:
 * `tensor_product.algebra_tensor_module.curry`
 * `tensor_product.algebra_tensor_module.uncurry`
 * `tensor_product.algebra_tensor_module.lcurry`
 * `tensor_product.algebra_tensor_module.lift`
 * `tensor_product.algebra_tensor_module.lift.equiv`
 * `tensor_product.algebra_tensor_module.mk`
 * `tensor_product.algebra_tensor_module.assoc`

are just more general versions of the definitions already in `linear_algebra/tensor_product`. We
could thus consider replacing the less general definitions with these ones. If we do this, we
probably should still implement the less general ones as abbreviations to the more general ones with
fewer type arguments.
-/

universe u v₁ v₂ v₃ v₄

open TensorProduct

open TensorProduct

namespace TensorProduct

variable {R A M N P : Type _}

/-!
### The `A`-module structure on `A ⊗[R] M`
-/

open LinearMap

open Algebra (lsmul)

namespace AlgebraTensorModule

section Semiring

variable [CommSemiring R] [Semiring A] [Algebra R A]

variable [AddCommMonoid M] [Module R M] [Module A M] [IsScalarTower R A M]

variable [AddCommMonoid N] [Module R N]

variable [AddCommMonoid P] [Module R P] [Module A P] [IsScalarTower R A P]

theorem smul_eq_lsmul_rtensor (a : A) (x : M ⊗[R] N) : a • x = (lsmul R M a).rtensor N x :=
  rfl
#align tensor_product.algebra_tensor_module.smul_eq_lsmul_rtensor TensorProduct.AlgebraTensorModule.smul_eq_lsmul_rtensor

/-- Heterobasic version of `tensor_product.curry`:

Given a linear map `M ⊗[R] N →[A] P`, compose it with the canonical
bilinear map `M →[A] N →[R] M ⊗[R] N` to form a bilinear map `M →[A] N →[R] P`. -/
@[simps]
def curry (f : M ⊗[R] N →ₗ[A] P) : M →ₗ[A] N →ₗ[R] P :=
  {
    curry (f.restrictScalars
        R) with
    toFun := curry (f.restrictScalars R)
    map_smul' := fun c x => LinearMap.ext fun y => f.map_smul c (x ⊗ₜ y) }
#align tensor_product.algebra_tensor_module.curry TensorProduct.AlgebraTensorModule.curry

theorem restrictScalars_curry (f : M ⊗[R] N →ₗ[A] P) :
    RestrictScalars R (curry f) = curry (f.restrictScalars R) :=
  rfl
#align tensor_product.algebra_tensor_module.restrict_scalars_curry TensorProduct.AlgebraTensorModule.restrictScalars_curry

/-- Just as `tensor_product.ext` is marked `ext` instead of `tensor_product.ext'`, this is
a better `ext` lemma than `tensor_product.algebra_tensor_module.ext` below.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem curry_injective : Function.Injective (curry : (M ⊗ N →ₗ[A] P) → M →ₗ[A] N →ₗ[R] P) :=
  fun x y h =>
  LinearMap.restrictScalars_injective R <|
    curry_injective <| (congr_arg (LinearMap.restrictScalars R) h : _)
#align tensor_product.algebra_tensor_module.curry_injective TensorProduct.AlgebraTensorModule.curry_injective

theorem ext {g h : M ⊗[R] N →ₗ[A] P} (H : ∀ x y, g (x ⊗ₜ y) = h (x ⊗ₜ y)) : g = h :=
  curry_injective <| LinearMap.ext₂ H
#align tensor_product.algebra_tensor_module.ext TensorProduct.AlgebraTensorModule.ext

end Semiring

section CommSemiring

variable [CommSemiring R] [CommSemiring A] [Algebra R A]

variable [AddCommMonoid M] [Module R M] [Module A M] [IsScalarTower R A M]

variable [AddCommMonoid N] [Module R N]

variable [AddCommMonoid P] [Module R P] [Module A P] [IsScalarTower R A P]

/-- Heterobasic version of `tensor_product.lift`:

Constructing a linear map `M ⊗[R] N →[A] P` given a bilinear map `M →[A] N →[R] P` with the
property that its composition with the canonical bilinear map `M →[A] N →[R] M ⊗[R] N` is
the given bilinear map `M →[A] N →[R] P`. -/
@[simps]
def lift (f : M →ₗ[A] N →ₗ[R] P) : M ⊗[R] N →ₗ[A] P :=
  { lift (f.restrictScalars R) with
    map_smul' := fun c =>
      show
        ∀ x : M ⊗[R] N,
          (lift (f.restrictScalars R)).comp (lsmul R _ c) x =
            (lsmul R _ c).comp (lift (f.restrictScalars R)) x
        from
        ext_iff.1 <|
          TensorProduct.ext' fun x y => by
            simp only [comp_apply, Algebra.lsmul_coe, smul_tmul', lift.tmul,
              coe_restrict_scalars_eq_coe, f.map_smul, smul_apply] }
#align tensor_product.algebra_tensor_module.lift TensorProduct.AlgebraTensorModule.lift

@[simp]
theorem lift_tmul (f : M →ₗ[A] N →ₗ[R] P) (x : M) (y : N) : lift f (x ⊗ₜ y) = f x y :=
  rfl
#align tensor_product.algebra_tensor_module.lift_tmul TensorProduct.AlgebraTensorModule.lift_tmul

variable (R A M N P)

/-- Heterobasic version of `tensor_product.uncurry`:

Linearly constructing a linear map `M ⊗[R] N →[A] P` given a bilinear map `M →[A] N →[R] P`
with the property that its composition with the canonical bilinear map `M →[A] N →[R] M ⊗[R] N` is
the given bilinear map `M →[A] N →[R] P`. -/
@[simps]
def uncurry : (M →ₗ[A] N →ₗ[R] P) →ₗ[A] M ⊗[R] N →ₗ[A] P
    where
  toFun := lift
  map_add' f g := ext fun x y => by simp only [lift_tmul, add_apply]
  map_smul' c f := ext fun x y => by simp only [lift_tmul, smul_apply, RingHom.id_apply]
#align tensor_product.algebra_tensor_module.uncurry TensorProduct.AlgebraTensorModule.uncurry

/-- Heterobasic version of `tensor_product.lcurry`:

Given a linear map `M ⊗[R] N →[A] P`, compose it with the canonical
bilinear map `M →[A] N →[R] M ⊗[R] N` to form a bilinear map `M →[A] N →[R] P`. -/
@[simps]
def lcurry : (M ⊗[R] N →ₗ[A] P) →ₗ[A] M →ₗ[A] N →ₗ[R] P
    where
  toFun := curry
  map_add' f g := rfl
  map_smul' c f := rfl
#align tensor_product.algebra_tensor_module.lcurry TensorProduct.AlgebraTensorModule.lcurry

/-- Heterobasic version of `tensor_product.lift.equiv`:

A linear equivalence constructing a linear map `M ⊗[R] N →[A] P` given a
bilinear map `M →[A] N →[R] P` with the property that its composition with the
canonical bilinear map `M →[A] N →[R] M ⊗[R] N` is the given bilinear map `M →[A] N →[R] P`. -/
def lift.equiv : (M →ₗ[A] N →ₗ[R] P) ≃ₗ[A] M ⊗[R] N →ₗ[A] P :=
  LinearEquiv.ofLinear (uncurry R A M N P) (lcurry R A M N P)
    (LinearMap.ext fun f => ext fun x y => lift_tmul _ x y)
    (LinearMap.ext fun f => LinearMap.ext fun x => LinearMap.ext fun y => lift_tmul f x y)
#align tensor_product.algebra_tensor_module.lift.equiv TensorProduct.AlgebraTensorModule.lift.equiv

variable (R A M N P)

/-- Heterobasic version of `tensor_product.mk`:

The canonical bilinear map `M →[A] N →[R] M ⊗[R] N`. -/
@[simps]
def mk : M →ₗ[A] N →ₗ[R] M ⊗[R] N :=
  { mk R M N with map_smul' := fun c x => rfl }
#align tensor_product.algebra_tensor_module.mk TensorProduct.AlgebraTensorModule.mk

attribute [local ext] TensorProduct.ext

/-- Heterobasic version of `tensor_product.assoc`:

Linear equivalence between `(M ⊗[A] N) ⊗[R] P` and `M ⊗[A] (N ⊗[R] P)`. -/
def assoc : (M ⊗[A] P) ⊗[R] N ≃ₗ[A] M ⊗[A] P ⊗[R] N :=
  LinearEquiv.ofLinear
    (lift <|
      TensorProduct.uncurry A _ _ _ <| comp (lcurry R A _ _ _) <| TensorProduct.mk A M (P ⊗[R] N))
    (TensorProduct.uncurry A _ _ _ <|
      comp (uncurry R A _ _ _) <| by
        apply TensorProduct.curry
        exact mk R A _ _)
    (by
      ext
      rfl)
    (by
      ext
      simp only [curry_apply, TensorProduct.curry_apply, mk_apply, TensorProduct.mk_apply,
        uncurry_apply, TensorProduct.uncurry_apply, id_apply, lift_tmul, compr₂_apply,
        restrict_scalars_apply, Function.comp_apply, to_fun_eq_coe, lcurry_apply,
        LinearMap.comp_apply])
#align tensor_product.algebra_tensor_module.assoc TensorProduct.AlgebraTensorModule.assoc

end CommSemiring

end AlgebraTensorModule

end TensorProduct

namespace LinearMap

open TensorProduct

/-!
### The base-change of a linear map of `R`-modules to a linear map of `A`-modules
-/

section Semiring

variable {R A B M N : Type _} [CommSemiring R]

variable [Semiring A] [Algebra R A] [Semiring B] [Algebra R B]

variable [AddCommMonoid M] [Module R M] [AddCommMonoid N] [Module R N]

variable (r : R) (f g : M →ₗ[R] N)

variable (A)

/-- `base_change A f` for `f : M →ₗ[R] N` is the `A`-linear map `A ⊗[R] M →ₗ[A] A ⊗[R] N`. -/
def baseChange (f : M →ₗ[R] N) : A ⊗[R] M →ₗ[A] A ⊗[R] N
    where
  toFun := f.ltensor A
  map_add' := (f.ltensor A).map_add
  map_smul' a x :=
    show
      (f.ltensor A) (rtensor M (LinearMap.mul R A a) x) =
        (rtensor N ((LinearMap.mul R A) a)) ((ltensor A f) x)
      by
      rw [← comp_apply, ← comp_apply]
      simp only [ltensor_comp_rtensor, rtensor_comp_ltensor]
#align linear_map.base_change LinearMap.baseChange

variable {A}

@[simp]
theorem baseChange_tmul (a : A) (x : M) : f.base_change A (a ⊗ₜ x) = a ⊗ₜ f x :=
  rfl
#align linear_map.base_change_tmul LinearMap.baseChange_tmul

theorem baseChange_eq_ltensor : (f.base_change A : A ⊗ M → A ⊗ N) = f.ltensor A :=
  rfl
#align linear_map.base_change_eq_ltensor LinearMap.baseChange_eq_ltensor

@[simp]
theorem baseChange_add : (f + g).base_change A = f.base_change A + g.base_change A :=
  by
  ext
  simp [base_change_eq_ltensor]
#align linear_map.base_change_add LinearMap.baseChange_add

@[simp]
theorem baseChange_zero : baseChange A (0 : M →ₗ[R] N) = 0 :=
  by
  ext
  simp [base_change_eq_ltensor]
#align linear_map.base_change_zero LinearMap.baseChange_zero

@[simp]
theorem baseChange_smul : (r • f).base_change A = r • f.base_change A :=
  by
  ext
  simp [base_change_tmul]
#align linear_map.base_change_smul LinearMap.baseChange_smul

variable (R A M N)

/-- `base_change` as a linear map. -/
@[simps]
def baseChangeHom : (M →ₗ[R] N) →ₗ[R] A ⊗[R] M →ₗ[A] A ⊗[R] N
    where
  toFun := baseChange A
  map_add' := baseChange_add
  map_smul' := baseChange_smul
#align linear_map.base_change_hom LinearMap.baseChangeHom

end Semiring

section Ring

variable {R A B M N : Type _} [CommRing R]

variable [Ring A] [Algebra R A] [Ring B] [Algebra R B]

variable [AddCommGroup M] [Module R M] [AddCommGroup N] [Module R N]

variable (f g : M →ₗ[R] N)

@[simp]
theorem baseChange_sub : (f - g).base_change A = f.base_change A - g.base_change A :=
  by
  ext
  simp [base_change_eq_ltensor]
#align linear_map.base_change_sub LinearMap.baseChange_sub

@[simp]
theorem baseChange_neg : (-f).base_change A = -f.base_change A :=
  by
  ext
  simp [base_change_eq_ltensor]
#align linear_map.base_change_neg LinearMap.baseChange_neg

end Ring

end LinearMap

namespace Algebra

namespace TensorProduct

section Semiring

variable {R : Type u} [CommSemiring R]

variable {A : Type v₁} [Semiring A] [Algebra R A]

variable {B : Type v₂} [Semiring B] [Algebra R B]

/-!
### The `R`-algebra structure on `A ⊗[R] B`
-/

/-- (Implementation detail)
The multiplication map on `A ⊗[R] B`,
for a fixed pure tensor in the first argument,
as an `R`-linear map.
-/
def mulAux (a₁ : A) (b₁ : B) : A ⊗[R] B →ₗ[R] A ⊗[R] B :=
  TensorProduct.map (LinearMap.mulLeft R a₁) (LinearMap.mulLeft R b₁)
#align algebra.tensor_product.mul_aux Algebra.TensorProduct.mulAux

@[simp]
theorem mulAux_apply (a₁ a₂ : A) (b₁ b₂ : B) :
    (mulAux a₁ b₁) (a₂ ⊗ₜ[R] b₂) = (a₁ * a₂) ⊗ₜ[R] (b₁ * b₂) :=
  rfl
#align algebra.tensor_product.mul_aux_apply Algebra.TensorProduct.mulAux_apply

/-- (Implementation detail)
The multiplication map on `A ⊗[R] B`,
as an `R`-bilinear map.
-/
def mul : A ⊗[R] B →ₗ[R] A ⊗[R] B →ₗ[R] A ⊗[R] B :=
  TensorProduct.lift <|
    LinearMap.mk₂ R mulAux
      (fun x₁ x₂ y =>
        TensorProduct.ext' fun x' y' => by
          simp only [mul_aux_apply, LinearMap.add_apply, add_mul, add_tmul])
      (fun c x y =>
        TensorProduct.ext' fun x' y' => by
          simp only [mul_aux_apply, LinearMap.smul_apply, smul_tmul', smul_mul_assoc])
      (fun x y₁ y₂ =>
        TensorProduct.ext' fun x' y' => by
          simp only [mul_aux_apply, LinearMap.add_apply, add_mul, tmul_add])
      fun c x y =>
      TensorProduct.ext' fun x' y' => by
        simp only [mul_aux_apply, LinearMap.smul_apply, smul_tmul, smul_tmul', smul_mul_assoc]
#align algebra.tensor_product.mul Algebra.TensorProduct.mul

@[simp]
theorem mul_apply (a₁ a₂ : A) (b₁ b₂ : B) :
    mul (a₁ ⊗ₜ[R] b₁) (a₂ ⊗ₜ[R] b₂) = (a₁ * a₂) ⊗ₜ[R] (b₁ * b₂) :=
  rfl
#align algebra.tensor_product.mul_apply Algebra.TensorProduct.mul_apply

theorem mul_assoc' (mul : A ⊗[R] B →ₗ[R] A ⊗[R] B →ₗ[R] A ⊗[R] B)
    (h :
      ∀ (a₁ a₂ a₃ : A) (b₁ b₂ b₃ : B),
        mul (mul (a₁ ⊗ₜ[R] b₁) (a₂ ⊗ₜ[R] b₂)) (a₃ ⊗ₜ[R] b₃) =
          mul (a₁ ⊗ₜ[R] b₁) (mul (a₂ ⊗ₜ[R] b₂) (a₃ ⊗ₜ[R] b₃))) :
    ∀ x y z : A ⊗[R] B, mul (mul x y) z = mul x (mul y z) :=
  by
  intros
  apply TensorProduct.induction_on x
  · simp only [LinearMap.map_zero, LinearMap.zero_apply]
  apply TensorProduct.induction_on y
  · simp only [LinearMap.map_zero, forall_const, LinearMap.zero_apply]
  apply TensorProduct.induction_on z
  · simp only [LinearMap.map_zero, forall_const]
  · intros
    simp only [h]
  · intros
    simp only [LinearMap.map_add, *]
  · intros
    simp only [LinearMap.map_add, *, LinearMap.add_apply]
  · intros
    simp only [LinearMap.map_add, *, LinearMap.add_apply]
#align algebra.tensor_product.mul_assoc' Algebra.TensorProduct.mul_assoc'

theorem mul_assoc (x y z : A ⊗[R] B) : mul (mul x y) z = mul x (mul y z) :=
  mul_assoc' mul
    (by
      intros
      simp only [mul_apply, mul_assoc])
    x y z
#align algebra.tensor_product.mul_assoc Algebra.TensorProduct.mul_assoc

theorem one_mul (x : A ⊗[R] B) : mul (1 ⊗ₜ 1) x = x := by
  apply TensorProduct.induction_on x <;> simp (config := { contextual := true })
#align algebra.tensor_product.one_mul Algebra.TensorProduct.one_mul

theorem mul_one (x : A ⊗[R] B) : mul x (1 ⊗ₜ 1) = x := by
  apply TensorProduct.induction_on x <;> simp (config := { contextual := true })
#align algebra.tensor_product.mul_one Algebra.TensorProduct.mul_one

instance : One (A ⊗[R] B) where one := 1 ⊗ₜ 1

instance : AddMonoidWithOne (A ⊗[R] B) :=
  AddMonoidWithOne.unary

instance : Semiring (A ⊗[R] B) :=
  { (by infer_instance : AddMonoidWithOne (A ⊗[R] B)),
    (by infer_instance : AddCommMonoid
        (A ⊗[R] B)) with
    zero := 0
    add := (· + ·)
    one := 1
    mul := fun a b => mul a b
    one_mul := one_mul
    mul_one := mul_one
    mul_assoc := mul_assoc
    zero_mul := by simp
    mul_zero := by simp
    left_distrib := by simp
    right_distrib := by simp }

theorem one_def : (1 : A ⊗[R] B) = (1 : A) ⊗ₜ (1 : B) :=
  rfl
#align algebra.tensor_product.one_def Algebra.TensorProduct.one_def

@[simp]
theorem tmul_mul_tmul (a₁ a₂ : A) (b₁ b₂ : B) :
    a₁ ⊗ₜ[R] b₁ * a₂ ⊗ₜ[R] b₂ = (a₁ * a₂) ⊗ₜ[R] (b₁ * b₂) :=
  rfl
#align algebra.tensor_product.tmul_mul_tmul Algebra.TensorProduct.tmul_mul_tmul

@[simp]
theorem tmul_pow (a : A) (b : B) (k : ℕ) : a ⊗ₜ[R] b ^ k = (a ^ k) ⊗ₜ[R] (b ^ k) :=
  by
  induction' k with k ih
  · simp [one_def]
  · simp [pow_succ, ih]
#align algebra.tensor_product.tmul_pow Algebra.TensorProduct.tmul_pow

/-- The ring morphism `A →+* A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
@[simps]
def includeLeftRingHom : A →+* A ⊗[R] B
    where
  toFun a := a ⊗ₜ 1
  map_zero' := by simp
  map_add' := by simp [add_tmul]
  map_one' := rfl
  map_mul' := by simp
#align algebra.tensor_product.include_left_ring_hom Algebra.TensorProduct.includeLeftRingHom

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

instance leftAlgebra : Algebra S (A ⊗[R] B) :=
  { TensorProduct.includeLeftRingHom.comp (algebraMap S A),
    (by infer_instance :
      Module S
        (A ⊗[R]
          B)) with
    commutes' := fun r x => by
      apply TensorProduct.induction_on x
      · simp
      · intro a b
        dsimp
        rw [Algebra.commutes, _root_.mul_one, _root_.one_mul]
      · intro y y' h h'
        dsimp at h h'⊢
        simp only [mul_add, add_mul, h, h']
    smul_def' := fun r x => by
      apply TensorProduct.induction_on x
      · simp [smul_zero]
      · intro a b
        dsimp
        rw [TensorProduct.smul_tmul', Algebra.smul_def r a, _root_.one_mul]
      · intros
        dsimp
        simp [smul_add, mul_add, *] }
#align algebra.tensor_product.left_algebra Algebra.TensorProduct.leftAlgebra

-- This is for the `undergrad.yaml` list.
/-- The tensor product of two `R`-algebras is an `R`-algebra. -/
instance : Algebra R (A ⊗[R] B) :=
  inferInstance

@[simp]
theorem algebraMap_apply (r : S) : (algebraMap S (A ⊗[R] B)) r = (algebraMap S A) r ⊗ₜ 1 :=
  rfl
#align algebra.tensor_product.algebra_map_apply Algebra.TensorProduct.algebraMap_apply

instance : IsScalarTower R S (A ⊗[R] B) :=
  ⟨fun a b c => by simp⟩

variable {C : Type v₃} [Semiring C] [Algebra R C]

@[ext]
theorem ext {g h : A ⊗[R] B →ₐ[R] C} (H : ∀ a b, g (a ⊗ₜ b) = h (a ⊗ₜ b)) : g = h :=
  by
  apply @AlgHom.toLinearMap_injective R (A ⊗[R] B) C _ _ _ _ _ _ _ _
  ext
  simp [H]
#align algebra.tensor_product.ext Algebra.TensorProduct.ext

/-- The `R`-algebra morphism `A →ₐ[R] A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
def includeLeft : A →ₐ[R] A ⊗[R] B :=
  { includeLeftRingHom with commutes' := by simp }
#align algebra.tensor_product.include_left Algebra.TensorProduct.includeLeft

@[simp]
theorem includeLeft_apply (a : A) : (includeLeft : A →ₐ[R] A ⊗[R] B) a = a ⊗ₜ 1 :=
  rfl
#align algebra.tensor_product.include_left_apply Algebra.TensorProduct.includeLeft_apply

/-- The algebra morphism `B →ₐ[R] A ⊗[R] B` sending `b` to `1 ⊗ₜ b`. -/
def includeRight : B →ₐ[R] A ⊗[R] B where
  toFun b := 1 ⊗ₜ b
  map_zero' := by simp
  map_add' := by simp [tmul_add]
  map_one' := rfl
  map_mul' := by simp
  commutes' r := by
    simp only [algebra_map_apply]
    trans r • (1 : A) ⊗ₜ[R] (1 : B)
    · rw [← tmul_smul, Algebra.smul_def]
      simp
    · simp [Algebra.smul_def]
#align algebra.tensor_product.include_right Algebra.TensorProduct.includeRight

@[simp]
theorem includeRight_apply (b : B) : (includeRight : B →ₐ[R] A ⊗[R] B) b = 1 ⊗ₜ b :=
  rfl
#align algebra.tensor_product.include_right_apply Algebra.TensorProduct.includeRight_apply

theorem includeLeft_comp_algebraMap {R S T : Type _} [CommRing R] [CommRing S] [CommRing T]
    [Algebra R S] [Algebra R T] :
    (includeLeft.toRingHom.comp (algebraMap R S) : R →+* S ⊗[R] T) =
      includeRight.toRingHom.comp (algebraMap R T) :=
  by
  ext
  simp
#align algebra.tensor_product.include_left_comp_algebra_map Algebra.TensorProduct.includeLeft_comp_algebraMap

end Semiring

section Ring

variable {R : Type u} [CommRing R]

variable {A : Type v₁} [Ring A] [Algebra R A]

variable {B : Type v₂} [Ring B] [Algebra R B]

instance : Ring (A ⊗[R] B) :=
  { (by infer_instance : AddCommGroup (A ⊗[R] B)), (by infer_instance : Semiring (A ⊗[R] B)) with }

end Ring

section CommRing

variable {R : Type u} [CommRing R]

variable {A : Type v₁} [CommRing A] [Algebra R A]

variable {B : Type v₂} [CommRing B] [Algebra R B]

instance : CommRing (A ⊗[R] B) :=
  { (by infer_instance : Ring (A ⊗[R] B)) with
    mul_comm := fun x y => by
      apply TensorProduct.induction_on x
      · simp
      · intro a₁ b₁
        apply TensorProduct.induction_on y
        · simp
        · intro a₂ b₂
          simp [mul_comm]
        · intro a₂ b₂ ha hb
          simp [mul_add, add_mul, ha, hb]
      · intro x₁ x₂ h₁ h₂
        simp [mul_add, add_mul, h₁, h₂] }

section RightAlgebra

/-- `S ⊗[R] T` has a `T`-algebra structure. This is not a global instance or else the action of
`S` on `S ⊗[R] S` would be ambiguous. -/
@[reducible]
def rightAlgebra : Algebra B (A ⊗[R] B) :=
  (Algebra.TensorProduct.includeRight.toRingHom : B →+* A ⊗[R] B).toAlgebra
#align algebra.tensor_product.right_algebra Algebra.TensorProduct.rightAlgebra

attribute [local instance] tensor_product.right_algebra

instance right_isScalarTower : IsScalarTower R B (A ⊗[R] B) :=
  IsScalarTower.of_algebraMap_eq fun r => (Algebra.TensorProduct.includeRight.commutes r).symm
#align algebra.tensor_product.right_is_scalar_tower Algebra.TensorProduct.right_isScalarTower

end RightAlgebra

end CommRing

/-- Verify that typeclass search finds the ring structure on `A ⊗[ℤ] B`
when `A` and `B` are merely rings, by treating both as `ℤ`-algebras.
-/
example {A : Type v₁} [Ring A] {B : Type v₂} [Ring B] : Ring (A ⊗[ℤ] B) := by infer_instance

/-- Verify that typeclass search finds the comm_ring structure on `A ⊗[ℤ] B`
when `A` and `B` are merely comm_rings, by treating both as `ℤ`-algebras.
-/
example {A : Type v₁} [CommRing A] {B : Type v₂} [CommRing B] : CommRing (A ⊗[ℤ] B) := by
  infer_instance

/-!
We now build the structure maps for the symmetric monoidal category of `R`-algebras.
-/

section Monoidal

section

variable {R : Type u} [CommSemiring R]

variable {A : Type v₁} [Semiring A] [Algebra R A]

variable {B : Type v₂} [Semiring B] [Algebra R B]

variable {C : Type v₃} [Semiring C] [Algebra R C]

variable {D : Type v₄} [Semiring D] [Algebra R D]

/-- Build an algebra morphism from a linear map out of a tensor product,
and evidence of multiplicativity on pure tensors.
-/
def algHomOfLinearMapTensorProduct (f : A ⊗[R] B →ₗ[R] C)
    (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B), f ((a₁ * a₂) ⊗ₜ (b₁ * b₂)) = f (a₁ ⊗ₜ b₁) * f (a₂ ⊗ₜ b₂))
    (w₂ : ∀ r, f ((algebraMap R A) r ⊗ₜ[R] 1) = (algebraMap R C) r) : A ⊗[R] B →ₐ[R] C :=
  {
    f with
    map_one' := by rw [← (algebraMap R C).map_one, ← w₂, (algebraMap R A).map_one] <;> rfl
    map_zero' := by rw [LinearMap.toFun_eq_coe, map_zero]
    map_mul' := fun x y => by
      rw [LinearMap.toFun_eq_coe]
      apply TensorProduct.induction_on x
      · rw [MulZeroClass.zero_mul, map_zero, MulZeroClass.zero_mul]
      · intro a₁ b₁
        apply TensorProduct.induction_on y
        · rw [MulZeroClass.mul_zero, map_zero, MulZeroClass.mul_zero]
        · intro a₂ b₂
          rw [tmul_mul_tmul, w₁]
        · intro x₁ x₂ h₁ h₂
          rw [mul_add, map_add, map_add, mul_add, h₁, h₂]
      · intro x₁ x₂ h₁ h₂
        rw [add_mul, map_add, map_add, add_mul, h₁, h₂]
    commutes' := fun r => by rw [LinearMap.toFun_eq_coe, algebra_map_apply, w₂] }
#align algebra.tensor_product.alg_hom_of_linear_map_tensor_product Algebra.TensorProduct.algHomOfLinearMapTensorProduct

@[simp]
theorem algHomOfLinearMapTensorProduct_apply (f w₁ w₂ x) :
    (algHomOfLinearMapTensorProduct f w₁ w₂ : A ⊗[R] B →ₐ[R] C) x = f x :=
  rfl
#align algebra.tensor_product.alg_hom_of_linear_map_tensor_product_apply Algebra.TensorProduct.algHomOfLinearMapTensorProduct_apply

/-- Build an algebra equivalence from a linear equivalence out of a tensor product,
and evidence of multiplicativity on pure tensors.
-/
def algEquivOfLinearEquivTensorProduct (f : A ⊗[R] B ≃ₗ[R] C)
    (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B), f ((a₁ * a₂) ⊗ₜ (b₁ * b₂)) = f (a₁ ⊗ₜ b₁) * f (a₂ ⊗ₜ b₂))
    (w₂ : ∀ r, f ((algebraMap R A) r ⊗ₜ[R] 1) = (algebraMap R C) r) : A ⊗[R] B ≃ₐ[R] C :=
  { algHomOfLinearMapTensorProduct (f : A ⊗[R] B →ₗ[R] C) w₁ w₂, f with }
#align algebra.tensor_product.alg_equiv_of_linear_equiv_tensor_product Algebra.TensorProduct.algEquivOfLinearEquivTensorProduct

@[simp]
theorem algEquivOfLinearEquivTensorProduct_apply (f w₁ w₂ x) :
    (algEquivOfLinearEquivTensorProduct f w₁ w₂ : A ⊗[R] B ≃ₐ[R] C) x = f x :=
  rfl
#align algebra.tensor_product.alg_equiv_of_linear_equiv_tensor_product_apply Algebra.TensorProduct.algEquivOfLinearEquivTensorProduct_apply

/-- Build an algebra equivalence from a linear equivalence out of a triple tensor product,
and evidence of multiplicativity on pure tensors.
-/
def algEquivOfLinearEquivTripleTensorProduct (f : (A ⊗[R] B) ⊗[R] C ≃ₗ[R] D)
    (w₁ :
      ∀ (a₁ a₂ : A) (b₁ b₂ : B) (c₁ c₂ : C),
        f ((a₁ * a₂) ⊗ₜ (b₁ * b₂) ⊗ₜ (c₁ * c₂)) = f (a₁ ⊗ₜ b₁ ⊗ₜ c₁) * f (a₂ ⊗ₜ b₂ ⊗ₜ c₂))
    (w₂ : ∀ r, f (((algebraMap R A) r ⊗ₜ[R] (1 : B)) ⊗ₜ[R] (1 : C)) = (algebraMap R D) r) :
    (A ⊗[R] B) ⊗[R] C ≃ₐ[R] D :=
  { f with
    toFun := f
    map_mul' := fun x y => by
      apply TensorProduct.induction_on x
      · simp only [map_zero, MulZeroClass.zero_mul]
      · intro ab₁ c₁
        apply TensorProduct.induction_on y
        · simp only [map_zero, MulZeroClass.mul_zero]
        · intro ab₂ c₂
          apply TensorProduct.induction_on ab₁
          · simp only [zero_tmul, map_zero, MulZeroClass.zero_mul]
          · intro a₁ b₁
            apply TensorProduct.induction_on ab₂
            · simp only [zero_tmul, map_zero, MulZeroClass.mul_zero]
            · intros
              simp only [tmul_mul_tmul, w₁]
            · intro x₁ x₂ h₁ h₂
              simp only [tmul_mul_tmul] at h₁ h₂
              simp only [tmul_mul_tmul, mul_add, add_tmul, map_add, h₁, h₂]
          · intro x₁ x₂ h₁ h₂
            simp only [tmul_mul_tmul] at h₁ h₂
            simp only [tmul_mul_tmul, add_mul, add_tmul, map_add, h₁, h₂]
        · intro x₁ x₂ h₁ h₂
          simp only [tmul_mul_tmul, map_add, mul_add, add_mul, h₁, h₂]
      · intro x₁ x₂ h₁ h₂
        simp only [tmul_mul_tmul, map_add, mul_add, add_mul, h₁, h₂]
    commutes' := fun r => by simp [w₂] }
#align algebra.tensor_product.alg_equiv_of_linear_equiv_triple_tensor_product Algebra.TensorProduct.algEquivOfLinearEquivTripleTensorProduct

@[simp]
theorem algEquivOfLinearEquivTripleTensorProduct_apply (f w₁ w₂ x) :
    (algEquivOfLinearEquivTripleTensorProduct f w₁ w₂ : (A ⊗[R] B) ⊗[R] C ≃ₐ[R] D) x = f x :=
  rfl
#align algebra.tensor_product.alg_equiv_of_linear_equiv_triple_tensor_product_apply Algebra.TensorProduct.algEquivOfLinearEquivTripleTensorProduct_apply

end

variable {R : Type u} [CommSemiring R]

variable {A : Type v₁} [Semiring A] [Algebra R A]

variable {B : Type v₂} [Semiring B] [Algebra R B]

variable {C : Type v₃} [Semiring C] [Algebra R C]

variable {D : Type v₄} [Semiring D] [Algebra R D]

section

variable (R A)

/-- The base ring is a left identity for the tensor product of algebra, up to algebra isomorphism.
-/
protected def lid : R ⊗[R] A ≃ₐ[R] A :=
  algEquivOfLinearEquivTensorProduct (TensorProduct.lid R A) (by simp [mul_smul])
    (by simp [Algebra.smul_def])
#align algebra.tensor_product.lid Algebra.TensorProduct.lid

@[simp]
theorem lid_tmul (r : R) (a : A) : (TensorProduct.lid R A : R ⊗ A → A) (r ⊗ₜ a) = r • a := by
  simp [TensorProduct.lid]
#align algebra.tensor_product.lid_tmul Algebra.TensorProduct.lid_tmul

/-- The base ring is a right identity for the tensor product of algebra, up to algebra isomorphism.
-/
protected def rid : A ⊗[R] R ≃ₐ[R] A :=
  algEquivOfLinearEquivTensorProduct (TensorProduct.rid R A) (by simp [mul_smul])
    (by simp [Algebra.smul_def])
#align algebra.tensor_product.rid Algebra.TensorProduct.rid

@[simp]
theorem rid_tmul (r : R) (a : A) : (TensorProduct.rid R A : A ⊗ R → A) (a ⊗ₜ r) = r • a := by
  simp [TensorProduct.rid]
#align algebra.tensor_product.rid_tmul Algebra.TensorProduct.rid_tmul

section

variable (R A B)

/-- The tensor product of R-algebras is commutative, up to algebra isomorphism.
-/
protected def comm : A ⊗[R] B ≃ₐ[R] B ⊗[R] A :=
  algEquivOfLinearEquivTensorProduct (TensorProduct.comm R A B) (by simp) fun r =>
    by
    trans r • (1 : B) ⊗ₜ[R] (1 : A)
    · rw [← tmul_smul, Algebra.smul_def]
      simp
    · simp [Algebra.smul_def]
#align algebra.tensor_product.comm Algebra.TensorProduct.comm

@[simp]
theorem comm_tmul (a : A) (b : B) :
    (TensorProduct.comm R A B : A ⊗[R] B → B ⊗[R] A) (a ⊗ₜ b) = b ⊗ₜ a := by
  simp [TensorProduct.comm]
#align algebra.tensor_product.comm_tmul Algebra.TensorProduct.comm_tmul

theorem adjoin_tmul_eq_top : adjoin R { t : A ⊗[R] B | ∃ a b, a ⊗ₜ[R] b = t } = ⊤ :=
  top_le_iff.mp <| (top_le_iff.mpr <| span_tmul_eq_top R A B).trans (span_le_adjoin R _)
#align algebra.tensor_product.adjoin_tmul_eq_top Algebra.TensorProduct.adjoin_tmul_eq_top

end

section

variable {R A B C}

theorem assoc_aux_1 (a₁ a₂ : A) (b₁ b₂ : B) (c₁ c₂ : C) :
    (TensorProduct.assoc R A B C) (((a₁ * a₂) ⊗ₜ[R] (b₁ * b₂)) ⊗ₜ[R] (c₁ * c₂)) =
      (TensorProduct.assoc R A B C) ((a₁ ⊗ₜ[R] b₁) ⊗ₜ[R] c₁) *
        (TensorProduct.assoc R A B C) ((a₂ ⊗ₜ[R] b₂) ⊗ₜ[R] c₂) :=
  rfl
#align algebra.tensor_product.assoc_aux_1 Algebra.TensorProduct.assoc_aux_1

theorem assoc_aux_2 (r : R) :
    (TensorProduct.assoc R A B C) (((algebraMap R A) r ⊗ₜ[R] 1) ⊗ₜ[R] 1) =
      (algebraMap R (A ⊗ (B ⊗ C))) r :=
  rfl
#align algebra.tensor_product.assoc_aux_2 Algebra.TensorProduct.assoc_aux_2

variable (R A B C)

/-- The associator for tensor product of R-algebras, as an algebra isomorphism. -/
protected def assoc : (A ⊗[R] B) ⊗[R] C ≃ₐ[R] A ⊗[R] B ⊗[R] C :=
  algEquivOfLinearEquivTripleTensorProduct
    (TensorProduct.assoc.{u, v₁, v₂, v₃} R A B C : A ⊗ B ⊗ C ≃ₗ[R] A ⊗ (B ⊗ C))
    (@Algebra.TensorProduct.assoc_aux_1.{u, v₁, v₂, v₃} R _ A _ _ B _ _ C _ _)
    (@Algebra.TensorProduct.assoc_aux_2.{u, v₁, v₂, v₃} R _ A _ _ B _ _ C _ _)
#align algebra.tensor_product.assoc Algebra.TensorProduct.assoc

variable {R A B C}

@[simp]
theorem assoc_tmul (a : A) (b : B) (c : C) :
    (TensorProduct.assoc R A B C : (A ⊗[R] B) ⊗[R] C → A ⊗[R] B ⊗[R] C) (a ⊗ₜ b ⊗ₜ c) =
      a ⊗ₜ (b ⊗ₜ c) :=
  rfl
#align algebra.tensor_product.assoc_tmul Algebra.TensorProduct.assoc_tmul

end

variable {R A B C D}

/-- The tensor product of a pair of algebra morphisms. -/
def map (f : A →ₐ[R] B) (g : C →ₐ[R] D) : A ⊗[R] C →ₐ[R] B ⊗[R] D :=
  algHomOfLinearMapTensorProduct (TensorProduct.map f.toLinearMap g.toLinearMap) (by simp)
    (by simp [AlgHom.commutes])
#align algebra.tensor_product.map Algebra.TensorProduct.map

@[simp]
theorem map_tmul (f : A →ₐ[R] B) (g : C →ₐ[R] D) (a : A) (c : C) : map f g (a ⊗ₜ c) = f a ⊗ₜ g c :=
  rfl
#align algebra.tensor_product.map_tmul Algebra.TensorProduct.map_tmul

@[simp]
theorem map_comp_includeLeft (f : A →ₐ[R] B) (g : C →ₐ[R] D) :
    (map f g).comp includeLeft = includeLeft.comp f :=
  AlgHom.ext <| by simp
#align algebra.tensor_product.map_comp_include_left Algebra.TensorProduct.map_comp_includeLeft

@[simp]
theorem map_comp_includeRight (f : A →ₐ[R] B) (g : C →ₐ[R] D) :
    (map f g).comp includeRight = includeRight.comp g :=
  AlgHom.ext <| by simp
#align algebra.tensor_product.map_comp_include_right Algebra.TensorProduct.map_comp_includeRight

theorem map_range (f : A →ₐ[R] B) (g : C →ₐ[R] D) :
    (map f g).range = (includeLeft.comp f).range ⊔ (includeRight.comp g).range :=
  by
  apply le_antisymm
  · rw [← map_top, ← adjoin_tmul_eq_top, ← adjoin_image, adjoin_le_iff]
    rintro _ ⟨_, ⟨a, b, rfl⟩, rfl⟩
    rw [map_tmul, ← _root_.mul_one (f a), ← _root_.one_mul (g b), ← tmul_mul_tmul]
    exact mul_mem_sup (AlgHom.mem_range_self _ a) (AlgHom.mem_range_self _ b)
  · rw [← map_comp_include_left f g, ← map_comp_include_right f g]
    exact sup_le (AlgHom.range_comp_le_range _ _) (AlgHom.range_comp_le_range _ _)
#align algebra.tensor_product.map_range Algebra.TensorProduct.map_range

/-- Construct an isomorphism between tensor products of R-algebras
from isomorphisms between the tensor factors.
-/
def congr (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) : A ⊗[R] C ≃ₐ[R] B ⊗[R] D :=
  AlgEquiv.ofAlgHom (map f g) (map f.symm g.symm) (ext fun b d => by simp) (ext fun a c => by simp)
#align algebra.tensor_product.congr Algebra.TensorProduct.congr

@[simp]
theorem congr_apply (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) (x) :
    congr f g x = (map (f : A →ₐ[R] B) (g : C →ₐ[R] D)) x :=
  rfl
#align algebra.tensor_product.congr_apply Algebra.TensorProduct.congr_apply

@[simp]
theorem congr_symm_apply (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) (x) :
    (congr f g).symm x = (map (f.symm : B →ₐ[R] A) (g.symm : D →ₐ[R] C)) x :=
  rfl
#align algebra.tensor_product.congr_symm_apply Algebra.TensorProduct.congr_symm_apply

end

end Monoidal

section

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

variable [Algebra R A] [Algebra R B] [Algebra R S]

variable (f : A →ₐ[R] S) (g : B →ₐ[R] S)

variable (R)

/-- `linear_map.mul'` is an alg_hom on commutative rings. -/
def lmul' : S ⊗[R] S →ₐ[R] S :=
  algHomOfLinearMapTensorProduct (LinearMap.mul' R S)
    (fun a₁ a₂ b₁ b₂ => by simp only [LinearMap.mul'_apply, mul_mul_mul_comm]) fun r => by
    simp only [LinearMap.mul'_apply, _root_.mul_one]
#align algebra.tensor_product.lmul' Algebra.TensorProduct.lmul'

variable {R}

theorem lmul'_toLinearMap : (lmul' R : _ →ₐ[R] S).toLinearMap = LinearMap.mul' R S :=
  rfl
#align algebra.tensor_product.lmul'_to_linear_map Algebra.TensorProduct.lmul'_toLinearMap

@[simp]
theorem lmul'_apply_tmul (a b : S) : lmul' R (a ⊗ₜ[R] b) = a * b :=
  rfl
#align algebra.tensor_product.lmul'_apply_tmul Algebra.TensorProduct.lmul'_apply_tmul

@[simp]
theorem lmul'_comp_includeLeft : (lmul' R : _ →ₐ[R] S).comp includeLeft = AlgHom.id R S :=
  AlgHom.ext <| mul_one
#align algebra.tensor_product.lmul'_comp_include_left Algebra.TensorProduct.lmul'_comp_includeLeft

@[simp]
theorem lmul'_comp_includeRight : (lmul' R : _ →ₐ[R] S).comp includeRight = AlgHom.id R S :=
  AlgHom.ext <| one_mul
#align algebra.tensor_product.lmul'_comp_include_right Algebra.TensorProduct.lmul'_comp_includeRight

/-- If `S` is commutative, for a pair of morphisms `f : A →ₐ[R] S`, `g : B →ₐ[R] S`,
We obtain a map `A ⊗[R] B →ₐ[R] S` that commutes with `f`, `g` via `a ⊗ b ↦ f(a) * g(b)`.
-/
def productMap : A ⊗[R] B →ₐ[R] S :=
  (lmul' R).comp (TensorProduct.map f g)
#align algebra.tensor_product.product_map Algebra.TensorProduct.productMap

@[simp]
theorem productMap_apply_tmul (a : A) (b : B) : productMap f g (a ⊗ₜ b) = f a * g b :=
  by
  unfold product_map lmul'
  simp
#align algebra.tensor_product.product_map_apply_tmul Algebra.TensorProduct.productMap_apply_tmul

theorem productMap_left_apply (a : A) : productMap f g ((includeLeft : A →ₐ[R] A ⊗ B) a) = f a := by
  simp
#align algebra.tensor_product.product_map_left_apply Algebra.TensorProduct.productMap_left_apply

@[simp]
theorem productMap_left : (productMap f g).comp includeLeft = f :=
  AlgHom.ext <| by simp
#align algebra.tensor_product.product_map_left Algebra.TensorProduct.productMap_left

theorem productMap_right_apply (b : B) : productMap f g (includeRight b) = g b := by simp
#align algebra.tensor_product.product_map_right_apply Algebra.TensorProduct.productMap_right_apply

@[simp]
theorem productMap_right : (productMap f g).comp includeRight = g :=
  AlgHom.ext <| by simp
#align algebra.tensor_product.product_map_right Algebra.TensorProduct.productMap_right

theorem productMap_range : (productMap f g).range = f.range ⊔ g.range := by
  rw [product_map, AlgHom.range_comp, map_range, map_sup, ← AlgHom.range_comp, ← AlgHom.range_comp,
    ← AlgHom.comp_assoc, ← AlgHom.comp_assoc, lmul'_comp_include_left, lmul'_comp_include_right,
    AlgHom.id_comp, AlgHom.id_comp]
#align algebra.tensor_product.product_map_range Algebra.TensorProduct.productMap_range

end

section

variable {R A A' B S : Type _}

variable [CommSemiring R] [CommSemiring A] [Semiring A'] [Semiring B] [CommSemiring S]

variable [Algebra R A] [Algebra R A'] [Algebra A A'] [IsScalarTower R A A'] [Algebra R B]

variable [Algebra R S] [Algebra A S] [IsScalarTower R A S]

/-- If `A`, `B` are `R`-algebras, `A'` is an `A`-algebra, then the product map of `f : A' →ₐ[A] S`
and `g : B →ₐ[R] S` is an `A`-algebra homomorphism. -/
@[simps]
def productLeftAlgHom (f : A' →ₐ[A] S) (g : B →ₐ[R] S) : A' ⊗[R] B →ₐ[A] S :=
  { (productMap (f.restrictScalars R) g).toRingHom with
    commutes' := fun r => by
      dsimp
      simp }
#align algebra.tensor_product.product_left_alg_hom Algebra.TensorProduct.productLeftAlgHom

end

section Basis

variable {k : Type _} [CommRing k] (R : Type _) [Ring R] [Algebra k R] {M : Type _}
  [AddCommMonoid M] [Module k M] {ι : Type _} (b : Basis ι k M)

/-- Given a `k`-algebra `R` and a `k`-basis of `M,` this is a `k`-linear isomorphism
`R ⊗[k] M ≃ (ι →₀ R)` (which is in fact `R`-linear). -/
noncomputable def basisAux : R ⊗[k] M ≃ₗ[k] ι →₀ R :=
  TensorProduct.congr (Finsupp.LinearEquiv.finsuppUnique k R PUnit).symm b.repr ≪≫ₗ
    (finsuppTensorFinsupp k R k PUnit ι).trans
      (Finsupp.lcongr (Equiv.uniqueProd ι PUnit) (TensorProduct.rid k R))
#align algebra.tensor_product.basis_aux Algebra.TensorProduct.basisAux

variable {R}

theorem basisAux_tmul (r : R) (m : M) :
    basisAux R b (r ⊗ₜ m) = r • Finsupp.mapRange (algebraMap k R) (map_zero _) (b.repr m) :=
  by
  ext
  simp [basis_aux, ← Algebra.commutes, Algebra.smul_def]
#align algebra.tensor_product.basis_aux_tmul Algebra.TensorProduct.basisAux_tmul

theorem basisAux_map_smul (r : R) (x : R ⊗[k] M) : basisAux R b (r • x) = r • basisAux R b x :=
  TensorProduct.induction_on x (by simp)
    (fun x y => by simp only [TensorProduct.smul_tmul', basis_aux_tmul, smul_assoc])
    fun x y hx hy => by simp [hx, hy]
#align algebra.tensor_product.basis_aux_map_smul Algebra.TensorProduct.basisAux_map_smul

variable (R)

/-- Given a `k`-algebra `R`, this is the `R`-basis of `R ⊗[k] M` induced by a `k`-basis of `M`. -/
noncomputable def basis : Basis ι R (R ⊗[k] M)
    where repr := { basisAux R b with map_smul' := basisAux_map_smul b }
#align algebra.tensor_product.basis Algebra.TensorProduct.basis

variable {R}

@[simp]
theorem basis_repr_tmul (r : R) (m : M) :
    (basis R b).repr (r ⊗ₜ m) = r • Finsupp.mapRange (algebraMap k R) (map_zero _) (b.repr m) :=
  basisAux_tmul _ _ _
#align algebra.tensor_product.basis_repr_tmul Algebra.TensorProduct.basis_repr_tmul

@[simp]
theorem basis_repr_symm_apply (r : R) (i : ι) :
    (basis R b).repr.symm (Finsupp.single i r) = r ⊗ₜ b.repr.symm (Finsupp.single i 1) := by
  simp [Basis, Equiv.uniqueProd_symm_apply, basis_aux]
#align algebra.tensor_product.basis_repr_symm_apply Algebra.TensorProduct.basis_repr_symm_apply

end Basis

end TensorProduct

end Algebra

namespace Module

variable {R M N : Type _} [CommSemiring R]

variable [AddCommMonoid M] [AddCommMonoid N]

variable [Module R M] [Module R N]

/-- The algebra homomorphism from `End M ⊗ End N` to `End (M ⊗ N)` sending `f ⊗ₜ g` to
the `tensor_product.map f g`, the tensor product of the two maps. -/
def endTensorEndAlgHom : End R M ⊗[R] End R N →ₐ[R] End R (M ⊗[R] N) :=
  by
  refine' Algebra.TensorProduct.algHomOfLinearMapTensorProduct (hom_tensor_hom_map R M N M N) _ _
  · intro f₁ f₂ g₁ g₂
    simp only [hom_tensor_hom_map_apply, TensorProduct.map_mul]
  · intro r
    simp only [hom_tensor_hom_map_apply]
    ext (m n)
    simp [smul_tmul]
#align module.End_tensor_End_alg_hom Module.endTensorEndAlgHom

theorem endTensorEndAlgHom_apply (f : End R M) (g : End R N) :
    endTensorEndAlgHom (f ⊗ₜ[R] g) = TensorProduct.map f g := by
  simp only [End_tensor_End_alg_hom, Algebra.TensorProduct.algHomOfLinearMapTensorProduct_apply,
    hom_tensor_hom_map_apply]
#align module.End_tensor_End_alg_hom_apply Module.endTensorEndAlgHom_apply

end Module

theorem Subalgebra.finiteDimensional_sup {K L : Type _} [Field K] [CommRing L] [Algebra K L]
    (E1 E2 : Subalgebra K L) [FiniteDimensional K E1] [FiniteDimensional K E2] :
    FiniteDimensional K ↥(E1 ⊔ E2) :=
  by
  rw [← E1.range_val, ← E2.range_val, ← Algebra.TensorProduct.productMap_range]
  exact (Algebra.TensorProduct.productMap E1.val E2.val).toLinearMap.finiteDimensional_range
#align subalgebra.finite_dimensional_sup Subalgebra.finiteDimensional_sup

namespace TensorProduct.Algebra

variable {R A B M : Type _}

variable [CommSemiring R] [AddCommMonoid M] [Module R M]

variable [Semiring A] [Semiring B] [Module A M] [Module B M]

variable [Algebra R A] [Algebra R B]

variable [IsScalarTower R A M] [IsScalarTower R B M]

/-- An auxiliary definition, used for constructing the `module (A ⊗[R] B) M` in
`tensor_product.algebra.module` below. -/
def moduleAux : A ⊗[R] B →ₗ[R] M →ₗ[R] M :=
  TensorProduct.lift
    { toFun := fun a => a • (Algebra.lsmul R M : B →ₐ[R] Module.End R M).toLinearMap
      map_add' := fun r t => by
        ext
        simp only [add_smul, LinearMap.add_apply]
      map_smul' := fun n r => by
        ext
        simp only [RingHom.id_apply, LinearMap.smul_apply, smul_assoc] }
#align tensor_product.algebra.module_aux TensorProduct.Algebra.moduleAux

theorem moduleAux_apply (a : A) (b : B) (m : M) : moduleAux (a ⊗ₜ[R] b) m = a • b • m :=
  rfl
#align tensor_product.algebra.module_aux_apply TensorProduct.Algebra.moduleAux_apply

variable [SMulCommClass A B M]

/-- If `M` is a representation of two different `R`-algebras `A` and `B` whose actions commute,
then it is a representation the `R`-algebra `A ⊗[R] B`.

An important example arises from a semiring `S`; allowing `S` to act on itself via left and right
multiplication, the roles of `R`, `A`, `B`, `M` are played by `ℕ`, `S`, `Sᵐᵒᵖ`, `S`. This example
is important because a submodule of `S` as a `module` over `S ⊗[ℕ] Sᵐᵒᵖ` is a two-sided ideal.

NB: This is not an instance because in the case `B = A` and `M = A ⊗[R] A` we would have a diamond
of `smul` actions. Furthermore, this would not be a mere definitional diamond but a true
mathematical diamond in which `A ⊗[R] A` had two distinct scalar actions on itself: one from its
multiplication, and one from this would-be instance. Arguably we could live with this but in any
case the real fix is to address the ambiguity in notation, probably along the lines outlined here:
https://leanprover.zulipchat.com/#narrow/stream/144837-PR-reviews/topic/.234773.20base.20change/near/240929258
-/
protected def module : Module (A ⊗[R] B) M
    where
  smul x m := moduleAux x m
  zero_smul m := by simp only [map_zero, LinearMap.zero_apply]
  smul_zero x := by simp only [map_zero]
  smul_add x m₁ m₂ := by simp only [map_add]
  add_smul x y m := by simp only [map_add, LinearMap.add_apply]
  one_smul m := by simp only [module_aux_apply, Algebra.TensorProduct.one_def, one_smul]
  mul_smul x y m :=
    by
    apply TensorProduct.induction_on x <;> apply TensorProduct.induction_on y
    · simp only [MulZeroClass.mul_zero, map_zero, LinearMap.zero_apply]
    · intro a b
      simp only [MulZeroClass.zero_mul, map_zero, LinearMap.zero_apply]
    · intro z w hz hw
      simp only [MulZeroClass.zero_mul, map_zero, LinearMap.zero_apply]
    · intro a b
      simp only [MulZeroClass.mul_zero, map_zero, LinearMap.zero_apply]
    · intro a₁ b₁ a₂ b₂
      simp only [module_aux_apply, mul_smul, smul_comm a₁ b₂, Algebra.TensorProduct.tmul_mul_tmul,
        LinearMap.mul_apply]
    · intro z w hz hw a b
      simp only at hz hw
      simp only [mul_add, hz, hw, map_add, LinearMap.add_apply]
    · intro z w hz hw
      simp only [MulZeroClass.mul_zero, map_zero, LinearMap.zero_apply]
    · intro a b z w hz hw
      simp only at hz hw
      simp only [map_add, add_mul, LinearMap.add_apply, hz, hw]
    · intro u v hu hv z w hz hw
      simp only at hz hw
      simp only [add_mul, hz, hw, map_add, LinearMap.add_apply]
#align tensor_product.algebra.module TensorProduct.Algebra.module

attribute [local instance] TensorProduct.Algebra.module

theorem smul_def (a : A) (b : B) (m : M) : a ⊗ₜ[R] b • m = a • b • m :=
  rfl
#align tensor_product.algebra.smul_def TensorProduct.Algebra.smul_def

end TensorProduct.Algebra


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

/-!
# Lexicographic order on a sigma type

This defines the lexicographical order of two arbitrary relations on a sigma type and proves some
lemmas about `psigma.lex`, which is defined in core Lean.

Given a relation in the index type and a relation on each summand, the lexicographical order on the
sigma type relates `a` and `b` if their summands are related or they are in the same summand and
related by the summand's relation.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.list.lex`: Lexicographic order on lists.
* `data.sigma.order`: Lexicographic order on `Σ i, α i` per say.
* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
* `order.lexicographic`: Lexicographic order on `α × β`. Can be thought of as the special case of
  `sigma.lex` where all summands are the same
-/

namespace sigma
variables {ι : Type*} {α : ι → Type*} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : Π i, α i → α i → Prop}
  {a b : Σ i, α i}

/-- The lexicographical order on a sigma type. It takes in a relation on the index type and a
relation for each summand. `a` is related to `b` iff their summands are related or they are in the
same summand and are related through the summand's relation. -/
inductive lex (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) : Π a b : Σ i, α i, Prop
| left {i j : ι} (a : α i) (b : α j) : r i j → lex ⟨i, a⟩ ⟨j, b⟩
| right {i : ι} (a b : α i)          : s i a b → lex ⟨i, a⟩ ⟨i, b⟩

lemma lex_iff : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
begin
  split,
  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
    { exact or.inl hij },
    { exact or.inr ⟨rfl, hab⟩ } },
  { obtain ⟨i, a⟩ := a,
    obtain ⟨j, b⟩ := b,
    dsimp only,
    rintro (h | ⟨rfl, h⟩),
    { exact lex.left _ _ h },
    { exact lex.right _ _ h } }
end

instance lex.decidable (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) [decidable_eq ι]
  [decidable_rel r] [Π i, decidable_rel (s i)] :
  decidable_rel (lex r s) :=
λ a b, decidable_of_decidable_of_iff infer_instance lex_iff.symm

lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i}
  (h : lex r₁ s₁ a b) :
  lex r₂ s₂ a b :=
begin
  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
  { exact lex.left _ _ (hr _ _ hij) },
  { exact lex.right _ _ (hs _ _ _ hab) }
end

lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ i, α i} (h : lex r₁ s a b) :
  lex r₂ s a b :=
h.mono hr $ λ _ _ _, id

lemma lex.mono_right (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i} (h : lex r s₁ a b) :
  lex r s₂ a b :=
h.mono (λ _ _, id) hs

instance [Π i, is_refl (α i) (s i)] : is_refl _ (lex r s) := ⟨λ ⟨i, a⟩, lex.right _ _ $ refl _⟩

instance [is_irrefl ι r] [Π i, is_irrefl (α i) (s i)] : is_irrefl _ (lex r s) :=
⟨begin
  rintro _ (⟨i, j, a, b, hi⟩ | ⟨i, a, b, ha⟩),
  { exact irrefl _ hi },
  { exact irrefl _ ha }
end⟩

instance [is_trans ι r] [Π i, is_trans (α i) (s i)] : is_trans _ (lex r s) :=
⟨begin
  rintro _ _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, k, _, c, hk⟩ | ⟨_, _, c, hc⟩),
  { exact lex.left _ _ (trans hij hk) },
  { exact lex.left _ _ hij },
  { exact lex.left _ _ hk },
  { exact lex.right _ _ (trans hab hc) }
end⟩

instance [is_symm ι r] [Π i, is_symm (α i) (s i)] : is_symm _ (lex r s) :=
⟨begin
  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
  { exact lex.left _ _ (symm hij) },
  { exact lex.right _ _ (symm hab) }
end⟩

local attribute [instance] is_asymm.is_irrefl

instance [is_asymm ι r] [Π i, is_antisymm (α i) (s i)] : is_antisymm _ (lex r s) :=
⟨begin
  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, _, _, _, hji⟩ | ⟨_, _, _, hba⟩),
  { exact (asymm hij hji).elim },
  { exact (irrefl _ hij).elim },
  { exact (irrefl _ hji).elim },
  { exact ext rfl (heq_of_eq $ antisymm hab hba) }
end⟩

instance [is_trichotomous ι r] [Π i, is_total (α i) (s i)] : is_total _ (lex r s) :=
⟨begin
  rintro ⟨i, a⟩ ⟨j, b⟩,
  obtain hij | rfl | hji := trichotomous_of r i j,
  { exact or.inl (lex.left _ _ hij) },
  { obtain hab | hba := total_of (s i) a b,
    { exact or.inl (lex.right _ _ hab) },
    { exact or.inr (lex.right _ _ hba) } },
  { exact or.inr (lex.left _ _ hji) }
end⟩

instance [is_trichotomous ι r] [Π i, is_trichotomous (α i) (s i)] : is_trichotomous _ (lex r s) :=
⟨begin
  rintro ⟨i, a⟩ ⟨j, b⟩,
  obtain hij | rfl | hji := trichotomous_of r i j,
  { exact or.inl (lex.left _ _ hij) },
  { obtain hab | rfl | hba := trichotomous_of (s i) a b,
    { exact or.inl (lex.right _ _ hab) },
    { exact or.inr (or.inl rfl) },
    { exact or.inr (or.inr $ lex.right _ _ hba) } },
  { exact or.inr (or.inr $ lex.left _ _ hji) }
end⟩

end sigma

/-! ### `psigma` -/

namespace psigma
variables {ι : Sort*} {α : ι → Sort*} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : Π i, α i → α i → Prop}

lemma lex_iff {a b : Σ' i, α i} : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
begin
  split,
  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
    { exact or.inl hij },
    { exact or.inr ⟨rfl, hab⟩ } },
  { obtain ⟨i, a⟩ := a,
    obtain ⟨j, b⟩ := b,
    dsimp only,
    rintro (h | ⟨rfl, h⟩),
    { exact lex.left _ _ h },
    { exact lex.right _ h } }
end

instance lex.decidable (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) [decidable_eq ι]
  [decidable_rel r] [Π i, decidable_rel (s i)] :
  decidable_rel (lex r s) :=
λ a b, decidable_of_decidable_of_iff infer_instance lex_iff.symm

lemma lex.mono {r₁ r₂ : ι → ι → Prop} {s₁ s₂ : Π i, α i → α i → Prop}
  (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i}
  (h : lex r₁ s₁ a b) :
  lex r₂ s₂ a b :=
begin
  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
  { exact lex.left _ _ (hr _ _ hij) },
  { exact lex.right _ (hs _ _ _ hab) }
end

lemma lex.mono_left {r₁ r₂ : ι → ι → Prop} {s : Π i, α i → α i → Prop}
  (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ' i, α i} (h : lex r₁ s a b) :
  lex r₂ s a b :=
h.mono hr $ λ _ _ _, id

lemma lex.mono_right {r : ι → ι → Prop} {s₁ s₂ : Π i, α i → α i → Prop}
  (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i} (h : lex r s₁ a b) :
  lex r s₂ a b :=
h.mono (λ _ _, id) hs

end psigma


/-
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 ring_theory.subsemiring.pointwise
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupRingAction.Basic
import Mathlib.RingTheory.Subsemiring.Basic
import Mathlib.GroupTheory.Submonoid.Pointwise
import Mathlib.Data.Set.Pointwise.Basic

/-! # Pointwise instances on `Subsemiring`s

This file provides the action `Subsemiring.PointwiseMulAction` which matches the action of
`MulActionSet`.

This actions is available in the `Pointwise` locale.

## Implementation notes

This file is almost identical to `GroupTheory/Submonoid/Pointwise.lean`. Where possible, try to
keep them in sync.
-/

open Set

variable {M R : Type _}

namespace Subsemiring

section Monoid

variable [Monoid M] [Semiring R] [MulSemiringAction M R]

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

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

scoped[Pointwise] attribute [instance] Subsemiring.pointwiseMulAction

open Pointwise

theorem pointwise_smul_def {a : M} (S : Subsemiring R) :
    a • S = S.map (MulSemiringAction.toRingHom _ _ a) :=
  rfl
#align subsemiring.pointwise_smul_def Subsemiring.pointwise_smul_def

@[simp]
theorem coe_pointwise_smul (m : M) (S : Subsemiring R) : ↑(m • S) = m • (S : Set R) :=
  rfl
#align subsemiring.coe_pointwise_smul Subsemiring.coe_pointwise_smul

@[simp]
theorem pointwise_smul_toAddSubmonoid (m : M) (S : Subsemiring R) :
    (m • S).toAddSubmonoid = m • S.toAddSubmonoid :=
  rfl
#align subsemiring.pointwise_smul_to_add_submonoid Subsemiring.pointwise_smul_toAddSubmonoid

theorem smul_mem_pointwise_smul (m : M) (r : R) (S : Subsemiring R) : r ∈ S → m • r ∈ m • S :=
  (Set.smul_mem_smul_set : _ → _ ∈ m • (S : Set R))
#align subsemiring.smul_mem_pointwise_smul Subsemiring.smul_mem_pointwise_smul

theorem mem_smul_pointwise_iff_exists (m : M) (r : R) (S : Subsemiring R) :
    r ∈ m • S ↔ ∃ s : R, s ∈ S ∧ m • s = r :=
  (Set.mem_smul_set : r ∈ m • (S : Set R) ↔ _)
#align subsemiring.mem_smul_pointwise_iff_exists Subsemiring.mem_smul_pointwise_iff_exists

@[simp]
theorem smul_bot (a : M) : a • (⊥ : Subsemiring R) = ⊥ :=
  map_bot _
#align subsemiring.smul_bot Subsemiring.smul_bot

theorem smul_sup (a : M) (S T : Subsemiring R) : a • (S ⊔ T) = a • S ⊔ a • T :=
  map_sup _ _ _
#align subsemiring.smul_sup Subsemiring.smul_sup

theorem smul_closure (a : M) (s : Set R) : a • closure s = closure (a • s) :=
  RingHom.map_closureS _ _
#align subsemiring.smul_closure Subsemiring.smul_closure

instance pointwise_central_scalar [MulSemiringAction Mᵐᵒᵖ R] [IsCentralScalar M R] :
    IsCentralScalar M (Subsemiring R) :=
  ⟨fun _a S => (congr_arg fun f => S.map f) <| RingHom.ext <| op_smul_eq_smul _⟩
#align subsemiring.pointwise_central_scalar Subsemiring.pointwise_central_scalar

end Monoid

section Group

variable [Group M] [Semiring R] [MulSemiringAction M R]

open Pointwise

@[simp]
theorem smul_mem_pointwise_smul_iff {a : M} {S : Subsemiring R} {x : R} : a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff
#align subsemiring.smul_mem_pointwise_smul_iff Subsemiring.smul_mem_pointwise_smul_iff

theorem mem_pointwise_smul_iff_inv_smul_mem {a : M} {S : Subsemiring R} {x : R} :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem
#align subsemiring.mem_pointwise_smul_iff_inv_smul_mem Subsemiring.mem_pointwise_smul_iff_inv_smul_mem

theorem mem_inv_pointwise_smul_iff {a : M} {S : Subsemiring R} {x : R} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff
#align subsemiring.mem_inv_pointwise_smul_iff Subsemiring.mem_inv_pointwise_smul_iff

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff {a : M} {S T : Subsemiring R} :
    a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff
#align subsemiring.pointwise_smul_le_pointwise_smul_iff Subsemiring.pointwise_smul_le_pointwise_smul_iff

theorem pointwise_smul_subset_iff {a : M} {S T : Subsemiring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
  set_smul_subset_iff
#align subsemiring.pointwise_smul_subset_iff Subsemiring.pointwise_smul_subset_iff

theorem subset_pointwise_smul_iff {a : M} {S T : Subsemiring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff
#align subsemiring.subset_pointwise_smul_iff Subsemiring.subset_pointwise_smul_iff

/-! TODO: add `equiv_smul` like we have for subgroup. -/

end Group

section GroupWithZero

variable [GroupWithZero M] [Semiring R] [MulSemiringAction M R]

open Pointwise

@[simp]
theorem smul_mem_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : Subsemiring R) (x : R) :
    a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff₀ ha (S : Set R) x
#align subsemiring.smul_mem_pointwise_smul_iff₀ Subsemiring.smul_mem_pointwise_smul_iff₀

theorem mem_pointwise_smul_iff_inv_smul_mem₀ {a : M} (ha : a ≠ 0) (S : Subsemiring R) (x : R) :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem₀ ha (S : Set R) x
#align subsemiring.mem_pointwise_smul_iff_inv_smul_mem₀ Subsemiring.mem_pointwise_smul_iff_inv_smul_mem₀

theorem mem_inv_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : Subsemiring R) (x : R) :
    x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff₀ ha (S : Set R) x
#align subsemiring.mem_inv_pointwise_smul_iff₀ Subsemiring.mem_inv_pointwise_smul_iff₀

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : Subsemiring R} :
    a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff₀ ha
#align subsemiring.pointwise_smul_le_pointwise_smul_iff₀ Subsemiring.pointwise_smul_le_pointwise_smul_iff₀

theorem pointwise_smul_le_iff₀ {a : M} (ha : a ≠ 0) {S T : Subsemiring R} :
    a • S ≤ T ↔ S ≤ a⁻¹ • T :=
  set_smul_subset_iff₀ ha
#align subsemiring.pointwise_smul_le_iff₀ Subsemiring.pointwise_smul_le_iff₀

theorem le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : Subsemiring R} :
    S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff₀ ha
#align subsemiring.le_pointwise_smul_iff₀ Subsemiring.le_pointwise_smul_iff₀

end GroupWithZero

end Subsemiring