/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.order
import Mathlib.PostPort

universes u_1 u_2 l

namespace Mathlib

/-!
# Cauchy sequences

A basic theory of Cauchy sequences, used in the construction of the reals and p-adic numbers. Where
applicable, lemmas that will be reused in other contexts have been stated in extra generality.

There are other "versions" of Cauchyness in the library, in particular Cauchy filters in topology.
This is a concrete implementation that is useful for simplicity and computability reasons.

## Important definitions

* `is_absolute_value`: a type class stating that `f : β → α` satisfies the axioms of an abs val
* `is_cau_seq`: a predicate that says `f : ℕ → β` is Cauchy.
* `cau_seq`: the type of Cauchy sequences valued in type `β` with respect to an absolute value
  function `abv`.

## Tags

sequence, cauchy, abs val, absolute value
-/

/-- A function `f` is an absolute value if it is nonnegative, zero only at 0, additive, and
multiplicative. -/
class is_absolute_value {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (f : β → α)
    where
  abv_nonneg : ∀ (x : β), 0 ≤ f x
  abv_eq_zero : ∀ {x : β}, f x = 0 ↔ x = 0
  abv_add : ∀ (x y : β), f (x + y) ≤ f x + f y
  abv_mul : ∀ (x y : β), f (x * y) = f x * f y

namespace is_absolute_value

theorem abv_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] : abv 0 = 0 :=
  iff.mpr (abv_eq_zero abv) rfl

theorem abv_one {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] [nontrivial β] : abv 1 = 1 :=
  sorry

theorem abv_pos {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] {a : β} : 0 < abv a ↔ a ≠ 0 :=
  sorry

theorem abv_neg {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] (a : β) : abv (-a) = abv a :=
  sorry

theorem abv_sub {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] (a : β) (b : β) : abv (a - b) = abv (b - a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abv (a - b) = abv (b - a))) (Eq.symm (neg_sub b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abv (-(b - a)) = abv (b - a))) (abv_neg abv (b - a))))
      (Eq.refl (abv (b - a))))

/-- `abv` as a `monoid_with_zero_hom`. -/
def abv_hom {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] [nontrivial β] : monoid_with_zero_hom β α :=
  monoid_with_zero_hom.mk abv (abv_zero abv) (abv_one abv) (abv_mul abv)

theorem abv_inv {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β] (abv : β → α)
    [is_absolute_value abv] (a : β) : abv (a⁻¹) = (abv a⁻¹) :=
  monoid_with_zero_hom.map_inv' (abv_hom abv) a

theorem abv_div {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β] (abv : β → α)
    [is_absolute_value abv] (a : β) (b : β) : abv (a / b) = abv a / abv b :=
  monoid_with_zero_hom.map_div (abv_hom abv) a b

theorem abv_sub_le {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] (a : β) (b : β) (c : β) : abv (a - c) ≤ abv (a - b) + abv (b - c) :=
  sorry

theorem sub_abv_le_abv_sub {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    (abv : β → α) [is_absolute_value abv] (a : β) (b : β) : abv a - abv b ≤ abv (a - b) :=
  sorry

theorem abs_abv_sub_le_abv_sub {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    (abv : β → α) [is_absolute_value abv] (a : β) (b : β) : abs (abv a - abv b) ≤ abv (a - b) :=
  sorry

theorem abv_pow {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] [nontrivial β]
    (abv : β → α) [is_absolute_value abv] (a : β) (n : ℕ) : abv (a ^ n) = abv a ^ n :=
  monoid_hom.map_pow (monoid_with_zero_hom.to_monoid_hom (abv_hom abv)) a n

end is_absolute_value

protected instance abs_is_absolute_value {α : Type u_1} [linear_ordered_field α] :
    is_absolute_value abs :=
  is_absolute_value.mk abs_nonneg (fun (_x : α) => abs_eq_zero) abs_add abs_mul

theorem exists_forall_ge_and {α : Type u_1} [linear_order α] {P : α → Prop} {Q : α → Prop} :
    (∃ (i : α), ∀ (j : α), j ≥ i → P j) →
        (∃ (i : α), ∀ (j : α), j ≥ i → Q j) → ∃ (i : α), ∀ (j : α), j ≥ i → P j ∧ Q j :=
  sorry

theorem rat_add_continuous_lemma {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    (abv : β → α) [is_absolute_value abv] {ε : α} (ε0 : 0 < ε) :
    ∃ (δ : α),
        ∃ (H : δ > 0),
          ∀ {a₁ a₂ b₁ b₂ : β},
            abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ + a₂ - (b₁ + b₂)) < ε :=
  sorry

theorem rat_mul_continuous_lemma {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    (abv : β → α) [is_absolute_value abv] {ε : α} {K₁ : α} {K₂ : α} (ε0 : 0 < ε) :
    ∃ (δ : α),
        ∃ (H : δ > 0),
          ∀ {a₁ a₂ b₁ b₂ : β},
            abv a₁ < K₁ →
              abv b₂ < K₂ → abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ * a₂ - b₁ * b₂) < ε :=
  sorry

theorem rat_inv_continuous_lemma {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β]
    (abv : β → α) [is_absolute_value abv] {ε : α} {K : α} (ε0 : 0 < ε) (K0 : 0 < K) :
    ∃ (δ : α),
        ∃ (H : δ > 0),
          ∀ {a b : β}, K ≤ abv a → K ≤ abv b → abv (a - b) < δ → abv (a⁻¹ - (b⁻¹)) < ε :=
  sorry

/-- A sequence is Cauchy if the distance between its entries tends to zero. -/
def is_cau_seq {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    (f : ℕ → β) :=
  ∀ (ε : α), ε > 0 → ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → abv (f j - f i) < ε

namespace is_cau_seq

theorem cauchy₂ {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : ℕ → β} (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
    ∃ (i : ℕ), ∀ (j k : ℕ), j ≥ i → k ≥ i → abv (f j - f k) < ε :=
  sorry

theorem cauchy₃ {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : ℕ → β} (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
    ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → ∀ (k : ℕ), k ≥ j → abv (f k - f j) < ε :=
  sorry

end is_cau_seq

/-- `cau_seq β abv` is the type of `β`-valued Cauchy sequences, with respect to the absolute value
function `abv`. -/
def cau_seq {α : Type u_1} [linear_ordered_field α] (β : Type u_2) [ring β] (abv : β → α) :=
  Subtype fun (f : ℕ → β) => is_cau_seq abv f

namespace cau_seq

protected instance has_coe_to_fun {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} : has_coe_to_fun (cau_seq β abv) :=
  has_coe_to_fun.mk (fun (x : cau_seq β abv) => ℕ → β) subtype.val

@[simp] theorem mk_to_fun {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} (f : ℕ → β) (hf : is_cau_seq abv f) : ⇑{ val := f, property := hf } = f :=
  rfl

theorem ext {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    {f : cau_seq β abv} {g : cau_seq β abv} (h : ∀ (i : ℕ), coe_fn f i = coe_fn g i) : f = g :=
  subtype.eq (funext h)

theorem is_cau {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    (f : cau_seq β abv) : is_cau_seq abv ⇑f :=
  subtype.property f

theorem cauchy {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    (f : cau_seq β abv) {ε : α} :
    0 < ε → ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → abv (coe_fn f j - coe_fn f i) < ε :=
  subtype.property f

/-- Given a Cauchy sequence `f`, create a Cauchy sequence from a sequence `g` with
the same values as `f`. -/
def of_eq {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    (f : cau_seq β abv) (g : ℕ → β) (e : ∀ (i : ℕ), coe_fn f i = g i) : cau_seq β abv :=
  { val := g, property := sorry }

theorem cauchy₂ {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (f : cau_seq β abv) {ε : α} :
    0 < ε → ∃ (i : ℕ), ∀ (j k : ℕ), j ≥ i → k ≥ i → abv (coe_fn f j - coe_fn f k) < ε :=
  is_cau_seq.cauchy₂ (subtype.property f)

theorem cauchy₃ {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (f : cau_seq β abv) {ε : α} :
    0 < ε → ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → ∀ (k : ℕ), k ≥ j → abv (coe_fn f k - coe_fn f j) < ε :=
  is_cau_seq.cauchy₃ (subtype.property f)

theorem bounded {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (f : cau_seq β abv) : ∃ (r : α), ∀ (i : ℕ), abv (coe_fn f i) < r :=
  sorry

theorem bounded' {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (f : cau_seq β abv) (x : α) :
    ∃ (r : α), ∃ (H : r > x), ∀ (i : ℕ), abv (coe_fn f i) < r :=
  sorry

protected instance has_add {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : Add (cau_seq β abv) :=
  { add :=
      fun (f g : cau_seq β abv) =>
        { val := fun (i : ℕ) => coe_fn f i + coe_fn g i, property := sorry } }

@[simp] theorem add_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (f : cau_seq β abv) (g : cau_seq β abv) (i : ℕ) :
    coe_fn (f + g) i = coe_fn f i + coe_fn g i :=
  rfl

/-- The constant Cauchy sequence. -/
def const {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] (abv : β → α)
    [is_absolute_value abv] (x : β) : cau_seq β abv :=
  { val := fun (i : ℕ) => x, property := sorry }

@[simp] theorem const_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (x : β) (i : ℕ) : coe_fn (const abv x) i = x :=
  rfl

theorem const_inj {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {x : β} {y : β} : const abv x = const abv y ↔ x = y :=
  { mp :=
      fun (h : const abv x = const abv y) => congr_arg (fun (f : cau_seq β abv) => coe_fn f 0) h,
    mpr := congr_arg fun {x : β} => const abv x }

protected instance has_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : HasZero (cau_seq β abv) :=
  { zero := const abv 0 }

protected instance has_one {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : HasOne (cau_seq β abv) :=
  { one := const abv 1 }

protected instance inhabited {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : Inhabited (cau_seq β abv) :=
  { default := 0 }

@[simp] theorem zero_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (i : ℕ) : coe_fn 0 i = 0 :=
  rfl

@[simp] theorem one_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (i : ℕ) : coe_fn 1 i = 1 :=
  rfl

theorem const_add {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (x : β) (y : β) : const abv (x + y) = const abv x + const abv y :=
  ext fun (i : ℕ) => rfl

protected instance has_mul {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : Mul (cau_seq β abv) :=
  { mul :=
      fun (f g : cau_seq β abv) =>
        { val := fun (i : ℕ) => coe_fn f i * coe_fn g i, property := sorry } }

@[simp] theorem mul_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (f : cau_seq β abv) (g : cau_seq β abv) (i : ℕ) :
    coe_fn (f * g) i = coe_fn f i * coe_fn g i :=
  rfl

theorem const_mul {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (x : β) (y : β) : const abv (x * y) = const abv x * const abv y :=
  ext fun (i : ℕ) => rfl

protected instance has_neg {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : Neg (cau_seq β abv) :=
  { neg :=
      fun (f : cau_seq β abv) => of_eq (const abv (-1) * f) (fun (x : ℕ) => -coe_fn f x) sorry }

@[simp] theorem neg_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (f : cau_seq β abv) (i : ℕ) :
    coe_fn (-f) i = -coe_fn f i :=
  rfl

theorem const_neg {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (x : β) : const abv (-x) = -const abv x :=
  ext fun (i : ℕ) => rfl

protected instance has_sub {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : Sub (cau_seq β abv) :=
  { sub :=
      fun (f g : cau_seq β abv) => of_eq (f + -g) (fun (x : ℕ) => coe_fn f x - coe_fn g x) sorry }

@[simp] theorem sub_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (f : cau_seq β abv) (g : cau_seq β abv) (i : ℕ) :
    coe_fn (f - g) i = coe_fn f i - coe_fn g i :=
  rfl

theorem const_sub {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (x : β) (y : β) : const abv (x - y) = const abv x - const abv y :=
  ext fun (i : ℕ) => rfl

protected instance ring {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : ring (cau_seq β abv) :=
  ring.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry Mul.mul sorry 1 sorry sorry sorry
    sorry

protected instance comm_ring {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [comm_ring β]
    {abv : β → α} [is_absolute_value abv] : comm_ring (cau_seq β abv) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry
    ring.one sorry sorry sorry sorry sorry

/-- `lim_zero f` holds when `f` approaches 0. -/
def lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    (f : cau_seq β abv) :=
  ∀ (ε : α), ε > 0 → ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → abv (coe_fn f j) < ε

theorem add_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (hf : lim_zero f)
    (hg : lim_zero g) : lim_zero (f + g) :=
  sorry

theorem mul_lim_zero_right {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] (f : cau_seq β abv) {g : cau_seq β abv}
    (hg : lim_zero g) : lim_zero (f * g) :=
  sorry

theorem mul_lim_zero_left {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} (g : cau_seq β abv)
    (hg : lim_zero f) : lim_zero (f * g) :=
  sorry

theorem neg_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} (hf : lim_zero f) : lim_zero (-f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (lim_zero (-f))) (Eq.symm (neg_one_mul f))))
    (mul_lim_zero_right (-1) hf)

theorem sub_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (hf : lim_zero f)
    (hg : lim_zero g) : lim_zero (f - g) :=
  eq.mpr
    (id
      ((fun (f f_1 : cau_seq β abv) (e_1 : f = f_1) => congr_arg lim_zero e_1) (f - g) (f + -g)
        (sub_eq_add_neg f g)))
    (eq.mp (Eq.refl (lim_zero (f + -g))) (add_lim_zero hf (neg_lim_zero hg)))

theorem lim_zero_sub_rev {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv}
    (hfg : lim_zero (f - g)) : lim_zero (g - f) :=
  eq.mpr (id (Eq.refl (lim_zero (g - f))))
    (eq.mp
      ((fun (f f_1 : cau_seq β abv) (e_1 : f = f_1) => congr_arg lim_zero e_1) (-(f - g)) (g - f)
        (neg_sub f g))
      (neg_lim_zero hfg))

theorem zero_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] : lim_zero 0 :=
  sorry

theorem const_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {x : β} : lim_zero (const abv x) ↔ x = 0 :=
  sorry

protected instance equiv {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] : setoid (cau_seq β abv) :=
  setoid.mk (fun (f g : cau_seq β abv) => lim_zero (f - g)) sorry

theorem add_equiv_add {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f1 : cau_seq β abv} {f2 : cau_seq β abv} {g1 : cau_seq β abv}
    {g2 : cau_seq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) : f1 + g1 ≈ f2 + g2 :=
  sorry

theorem neg_equiv_neg {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (hf : f ≈ g) : -f ≈ -g :=
  sorry

theorem equiv_def₃ {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (h : f ≈ g) {ε : α}
    (ε0 : 0 < ε) :
    ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → ∀ (k : ℕ), k ≥ j → abv (coe_fn f k - coe_fn g j) < ε :=
  sorry

theorem lim_zero_congr {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (h : f ≈ g) :
    lim_zero f ↔ lim_zero g :=
  sorry

theorem abv_pos_of_not_lim_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} (hf : ¬lim_zero f) :
    ∃ (K : α), ∃ (H : K > 0), ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → K ≤ abv (coe_fn f j) :=
  sorry

theorem of_near {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (f : ℕ → β) (g : cau_seq β abv)
    (h : ∀ (ε : α), ε > 0 → ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → abv (f j - coe_fn g j) < ε) :
    is_cau_seq abv f :=
  sorry

theorem not_lim_zero_of_not_congr_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2}
    [ring β] {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} (hf : ¬f ≈ 0) :
    ¬lim_zero f :=
  sorry

theorem mul_equiv_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] (g : cau_seq β abv) {f : cau_seq β abv} (hf : f ≈ 0) : g * f ≈ 0 :=
  sorry

theorem mul_not_equiv_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} {g : cau_seq β abv} (hf : ¬f ≈ 0)
    (hg : ¬g ≈ 0) : ¬f * g ≈ 0 :=
  sorry

theorem const_equiv {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [ring β] {abv : β → α}
    [is_absolute_value abv] {x : β} {y : β} : const abv x ≈ const abv y ↔ x = y :=
  sorry

theorem mul_equiv_zero' {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [comm_ring β]
    {abv : β → α} [is_absolute_value abv] (g : cau_seq β abv) {f : cau_seq β abv} (hf : f ≈ 0) :
    f * g ≈ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f * g ≈ 0)) (mul_comm f g))) (mul_equiv_zero g hf)

theorem one_not_equiv_zero {α : Type u_1} [linear_ordered_field α] {β : Type u_2}
    [integral_domain β] (abv : β → α) [is_absolute_value abv] : ¬const abv 1 ≈ const abv 0 :=
  sorry

theorem inv_aux {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β] {abv : β → α}
    [is_absolute_value abv] {f : cau_seq β abv} (hf : ¬lim_zero f) (ε : α) (H : ε > 0) :
    ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → abv (coe_fn f j⁻¹ - (coe_fn f i⁻¹)) < ε :=
  sorry

/-- Given a Cauchy sequence `f` with nonzero limit, create a Cauchy sequence with values equal to
the inverses of the values of `f`. -/
def inv {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β] {abv : β → α}
    [is_absolute_value abv] (f : cau_seq β abv) (hf : ¬lim_zero f) : cau_seq β abv :=
  { val := fun (j : ℕ) => coe_fn f j⁻¹, property := inv_aux hf }

@[simp] theorem inv_apply {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} (hf : ¬lim_zero f) (i : ℕ) :
    coe_fn (inv f hf) i = (coe_fn f i⁻¹) :=
  rfl

theorem inv_mul_cancel {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β]
    {abv : β → α} [is_absolute_value abv] {f : cau_seq β abv} (hf : ¬lim_zero f) :
    inv f hf * f ≈ 1 :=
  sorry

theorem const_inv {α : Type u_1} [linear_ordered_field α] {β : Type u_2} [field β] {abv : β → α}
    [is_absolute_value abv] {x : β} (hx : x ≠ 0) :
    const abv (x⁻¹) =
        inv (const abv x)
          (eq.mpr (id (Eq._oldrec (Eq.refl (¬lim_zero (const abv x))) (propext const_lim_zero)))
            hx) :=
  sorry

/-- The entries of a positive Cauchy sequence eventually have a positive lower bound. -/
def pos {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) :=
  ∃ (K : α), ∃ (H : K > 0), ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → K ≤ coe_fn f j

theorem not_lim_zero_of_pos {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} :
    pos f → ¬lim_zero f :=
  sorry

theorem const_pos {α : Type u_1} [linear_ordered_field α] {x : α} : pos (const abs x) ↔ 0 < x :=
  sorry

theorem add_pos {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} {g : cau_seq α abs} :
    pos f → pos g → pos (f + g) :=
  sorry

theorem pos_add_lim_zero {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} : pos f → lim_zero g → pos (f + g) :=
  sorry

protected theorem mul_pos {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} : pos f → pos g → pos (f * g) :=
  sorry

theorem trichotomy {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) :
    pos f ∨ lim_zero f ∨ pos (-f) :=
  sorry

protected instance has_lt {α : Type u_1} [linear_ordered_field α] : HasLess (cau_seq α abs) :=
  { Less := fun (f g : cau_seq α abs) => pos (g - f) }

protected instance has_le {α : Type u_1} [linear_ordered_field α] : HasLessEq (cau_seq α abs) :=
  { LessEq := fun (f g : cau_seq α abs) => f < g ∨ f ≈ g }

theorem lt_of_lt_of_eq {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} {h : cau_seq α abs} (fg : f < g) (gh : g ≈ h) : f < h :=
  sorry

theorem lt_of_eq_of_lt {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} {h : cau_seq α abs} (fg : f ≈ g) (gh : g < h) : f < h :=
  eq.mp (Eq._oldrec (Eq.refl (pos (h - g - (f - g)))) (sub_sub_sub_cancel_right h f g))
    (eq.mp
      (Eq._oldrec (Eq.refl (pos (h - g + -(f - g)))) (Eq.symm (sub_eq_add_neg (h - g) (f - g))))
      (pos_add_lim_zero gh (neg_lim_zero fg)))

theorem lt_trans {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} {g : cau_seq α abs}
    {h : cau_seq α abs} (fg : f < g) (gh : g < h) : f < h :=
  sorry

theorem lt_irrefl {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} : ¬f < f := sorry

theorem le_of_eq_of_le {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} {h : cau_seq α abs} (hfg : f ≈ g) (hgh : g ≤ h) : f ≤ h :=
  or.elim hgh (Or.inl ∘ lt_of_eq_of_lt hfg) (Or.inr ∘ setoid.trans hfg)

theorem le_of_le_of_eq {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs}
    {g : cau_seq α abs} {h : cau_seq α abs} (hfg : f ≤ g) (hgh : g ≈ h) : f ≤ h :=
  or.elim hfg (fun (h_1 : f < g) => Or.inl (lt_of_lt_of_eq h_1 hgh))
    fun (h_1 : f ≈ g) => Or.inr (setoid.trans h_1 hgh)

protected instance preorder {α : Type u_1} [linear_ordered_field α] : preorder (cau_seq α abs) :=
  preorder.mk (fun (f g : cau_seq α abs) => f < g ∨ f ≈ g) Less sorry sorry

theorem le_antisymm {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} {g : cau_seq α abs}
    (fg : f ≤ g) (gf : g ≤ f) : f ≈ g :=
  or.resolve_left fg (not_lt_of_le gf)

theorem lt_total {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) (g : cau_seq α abs) :
    f < g ∨ f ≈ g ∨ g < f :=
  sorry

theorem le_total {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) (g : cau_seq α abs) :
    f ≤ g ∨ g ≤ f :=
  or.imp_right Or.inl (iff.mpr or.assoc (lt_total f g))

theorem const_lt {α : Type u_1} [linear_ordered_field α] {x : α} {y : α} :
    const abs x < const abs y ↔ x < y :=
  sorry

theorem const_le {α : Type u_1} [linear_ordered_field α] {x : α} {y : α} :
    const abs x ≤ const abs y ↔ x ≤ y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (const abs x ≤ const abs y ↔ x ≤ y)) (propext le_iff_lt_or_eq)))
    (or_congr const_lt const_equiv)

theorem le_of_exists {α : Type u_1} [linear_ordered_field α] {f : cau_seq α abs} {g : cau_seq α abs}
    (h : ∃ (i : ℕ), ∀ (j : ℕ), j ≥ i → coe_fn f j ≤ coe_fn g j) : f ≤ g :=
  sorry

theorem exists_gt {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) :
    ∃ (a : α), f < const abs a :=
  sorry

theorem exists_lt {α : Type u_1} [linear_ordered_field α] (f : cau_seq α abs) :
    ∃ (a : α), const abs a < f :=
  sorry

end Mathlib


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

import ring_theory.witt_vector.frobenius
import ring_theory.witt_vector.verschiebung
import ring_theory.witt_vector.mul_p

/-!
## Identities between operations on the ring of Witt vectors

In this file we derive common identities between the Frobenius and Verschiebung operators.

## Main declarations

* `frobenius_verschiebung`: the composition of Frobenius and Verschiebung is multiplication by `p`
* `verschiebung_mul_frobenius`: the “projection formula”: `V(x * F y) = V x * y`
* `iterate_verschiebung_mul_coeff`: an identity from [Haze09] 6.2

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

namespace witt_vector

variables {p : ℕ} {R : Type*} [hp : fact p.prime] [comm_ring R]
local notation `𝕎` := witt_vector p -- type as `\bbW`
include hp
noncomputable theory

/-- The composition of Frobenius and Verschiebung is multiplication by `p`. -/
lemma frobenius_verschiebung (x : 𝕎 R) :
  frobenius (verschiebung x) = x * p :=
by { ghost_calc x, ghost_simp [mul_comm] }

/-- Verschiebung is the same as multiplication by `p` on the ring of Witt vectors of `zmod p`. -/
lemma verschiebung_zmod (x : 𝕎 (zmod p)) :
  verschiebung x = x * p :=
by rw [← frobenius_verschiebung, frobenius_zmodp]

variables (p R)

lemma coeff_p_pow [char_p R p] (i : ℕ) : (p ^ i : 𝕎 R).coeff i = 1 :=
begin
  induction i with i h,
  { simp only [one_coeff_zero, ne.def, pow_zero] },
  { rw [pow_succ', ← frobenius_verschiebung, coeff_frobenius_char_p,
        verschiebung_coeff_succ, h, one_pow], }
end

lemma coeff_p_pow_eq_zero [char_p R p] {i j : ℕ} (hj : j ≠ i) : (p ^ i : 𝕎 R).coeff j = 0 :=
begin
  induction i with i hi generalizing j,
  { rw [pow_zero, one_coeff_eq_of_pos],
    exact nat.pos_of_ne_zero hj },
  { rw [pow_succ', ← frobenius_verschiebung, coeff_frobenius_char_p],
    cases j,
    { rw [verschiebung_coeff_zero, zero_pow],
      exact nat.prime.pos hp.out },
    { rw [verschiebung_coeff_succ, hi, zero_pow],
      { exact nat.prime.pos hp.out },
      { exact ne_of_apply_ne (λ (j : ℕ), j.succ) hj } } }
end

lemma coeff_p [char_p R p] (i : ℕ) : (p : 𝕎 R).coeff i = if i = 1 then 1 else 0 :=
begin
  split_ifs with hi,
  { simpa only [hi, pow_one] using coeff_p_pow p R 1, },
  { simpa only [pow_one] using coeff_p_pow_eq_zero p R hi, }
end

@[simp] lemma coeff_p_zero [char_p R p] : (p : 𝕎 R).coeff 0 = 0 :=
by { rw [coeff_p, if_neg], exact zero_ne_one }

@[simp] lemma coeff_p_one [char_p R p] : (p : 𝕎 R).coeff 1 = 1 :=
by rw [coeff_p, if_pos rfl]

lemma p_nonzero [nontrivial R] [char_p R p] : (p : 𝕎 R) ≠ 0 :=
by { intros h, simpa only [h, zero_coeff, zero_ne_one] using coeff_p_one p R }

lemma fraction_ring.p_nonzero [nontrivial R] [char_p R p] :
  (p : fraction_ring (𝕎 R)) ≠ 0 :=
by simpa using (is_fraction_ring.injective (𝕎 R) (fraction_ring (𝕎 R))).ne (p_nonzero _ _)

variables {p R}

/-- The “projection formula” for Frobenius and Verschiebung. -/
lemma verschiebung_mul_frobenius (x y : 𝕎 R) :
  verschiebung (x * frobenius y) = verschiebung x * y :=
by { ghost_calc x y, rintro ⟨⟩; ghost_simp [mul_assoc] }

lemma mul_char_p_coeff_zero [char_p R p] (x : 𝕎 R) : (x * p).coeff 0 = 0 :=
begin
  rw [← frobenius_verschiebung, coeff_frobenius_char_p, verschiebung_coeff_zero, zero_pow],
  exact nat.prime.pos hp.out
end

lemma mul_char_p_coeff_succ [char_p R p] (x : 𝕎 R) (i : ℕ) :
  (x * p).coeff (i + 1) = (x.coeff i)^p :=
by rw [← frobenius_verschiebung, coeff_frobenius_char_p, verschiebung_coeff_succ]

lemma verschiebung_frobenius [char_p R p] (x : 𝕎 R) :
  verschiebung (frobenius x) = x * p :=
begin
  ext ⟨i⟩,
  { rw [mul_char_p_coeff_zero, verschiebung_coeff_zero], },
  { rw [mul_char_p_coeff_succ, verschiebung_coeff_succ, coeff_frobenius_char_p], }
end

lemma verschiebung_frobenius_comm [char_p R p] :
  function.commute (verschiebung : 𝕎 R → 𝕎 R) frobenius :=
λ x, by rw [verschiebung_frobenius, frobenius_verschiebung]

/-!
## Iteration lemmas
-/

open function

lemma iterate_verschiebung_coeff (x : 𝕎 R) (n k : ℕ) :
  (verschiebung^[n] x).coeff (k + n) = x.coeff k :=
begin
  induction n with k ih,
  { simp },
  { rw [iterate_succ_apply', nat.add_succ, verschiebung_coeff_succ],
    exact ih }
end

lemma iterate_verschiebung_mul_left (x y : 𝕎 R) (i : ℕ) :
  (verschiebung^[i] x) * y = (verschiebung^[i] (x * (frobenius^[i] y))) :=
begin
  induction i with i ih generalizing y,
  { simp },
  { rw [iterate_succ_apply', ← verschiebung_mul_frobenius, ih, iterate_succ_apply'], refl }
end

section char_p

variable [char_p R p]

lemma iterate_verschiebung_mul (x y : 𝕎 R) (i j : ℕ) :
  (verschiebung^[i] x) * (verschiebung^[j] y) =
    (verschiebung^[i + j] ((frobenius^[j] x) * (frobenius^[i] y))) :=
begin
  calc
  _ = (verschiebung^[i] (x * (frobenius^[i] ((verschiebung^[j] y))))) : _
... = (verschiebung^[i] (x * (verschiebung^[j] ((frobenius^[i] y))))) : _
... = (verschiebung^[i] ((verschiebung^[j] ((frobenius^[i] y)) * x))) : _
... = (verschiebung^[i] ((verschiebung^[j] ((frobenius^[i] y) * (frobenius^[j] x))))) : _
... = (verschiebung^[i + j] ((frobenius^[i] y) * (frobenius^[j] x))) : _
... = _ : _,
  { apply iterate_verschiebung_mul_left },
  { rw verschiebung_frobenius_comm.iterate_iterate; apply_instance },
  { rw mul_comm },
  { rw iterate_verschiebung_mul_left },
  { rw iterate_add_apply },
  { rw mul_comm }
end

lemma iterate_frobenius_coeff (x : 𝕎 R) (i k : ℕ) :
  ((frobenius^[i] x)).coeff k = (x.coeff k)^(p^i) :=
begin
  induction i with i ih,
  { simp },
  { rw [iterate_succ_apply', coeff_frobenius_char_p, ih],
    ring_exp }
end

/-- This is a slightly specialized form of [Hazewinkel, *Witt Vectors*][Haze09] 6.2 equation 5. -/
lemma iterate_verschiebung_mul_coeff (x y : 𝕎 R) (i j : ℕ) :
  ((verschiebung^[i] x) * (verschiebung^[j] y)).coeff (i + j) =
    (x.coeff 0)^(p ^ j) * (y.coeff 0)^(p ^ i) :=
begin
  calc
  _ = (verschiebung^[i + j] ((frobenius^[j] x) * (frobenius^[i] y))).coeff (i + j) : _
... = ((frobenius^[j] x) * (frobenius^[i] y)).coeff 0 : _
... = (frobenius^[j] x).coeff 0 * ((frobenius^[i] y)).coeff 0 : _
... = _ : _,
  { rw iterate_verschiebung_mul },
  { convert iterate_verschiebung_coeff _ _ _ using 2,
    rw zero_add },
  { apply mul_coeff_zero },
  { simp only [iterate_frobenius_coeff] }
end

end char_p

end witt_vector


theorem ex1 : ∀ x : Int, ∃ n : Nat, n > x :=
  sorry

theorem ex2 : ∀ x : Int, ∃ n : Nat, x > n :=
  sorry

namespace Lt

def ex1 (x y : Nat) (i j : Int) :=
  x < i

def ex2 (x y : Nat) (i j : Int) :=
  i < x

def ex3 (x y : Nat) (i j : Int) :=
  i + 1 < x

def ex4 (x y : Nat) (i j : Int) :=
  i < x + 1

def ex5 (x y : Nat) (i j : Int) :=
  i < x + y

def ex6 (x y : Nat) (i j : Int) :=
  i + j < x + 0

def ex7 (x y : Nat) (i j : Int) :=
  i + j < x + i

def ex8 (x y : Nat) (i j : Int) :=
  i + 0 < x + i

def ex9 (n : UInt32) :=
  n < 0xd800

end Lt

namespace Eq

def ex1 (x y : Nat) (i j : Int) :=
  x = i

def ex2 (x y : Nat) (i j : Int) :=
  i = x

def ex3 (x y : Nat) (i j : Int) :=
  i + 1 = x

def ex4 (x y : Nat) (i j : Int) :=
  i = x + 1

def ex5 (x y : Nat) (i j : Int) :=
  i = x + y

def ex6 (x y : Nat) (i j : Int) :=
  i + j = x + 0

def ex7 (x y : Nat) (i j : Int) :=
  i + j = x + i

def ex8 (x y : Nat) (i j : Int) :=
  i + 0 = x + i

def ex9 (n : UInt32) :=
  n = 0xd800

end Eq

namespace BEq

def ex1 (x y : Nat) (i j : Int) :=
  x == i

def ex2 (x y : Nat) (i j : Int) :=
  i == x

def ex3 (x y : Nat) (i j : Int) :=
  i + 1 == x

def ex4 (x y : Nat) (i j : Int) :=
  i == x + 1

def ex5 (x y : Nat) (i j : Int) :=
  i == x + y

def ex6 (x y : Nat) (i j : Int) :=
  i + j == x + 0

def ex7 (x y : Nat) (i j : Int) :=
  i + j == x + i

def ex8 (x y : Nat) (i j : Int) :=
  i + 0 == x + i

def ex9 (n : UInt32) :=
  n == 0xd800

end BEq


import Src.Prover.Choice

namespace prover
noncomputable section

constant Set : Type
constant mem : Set → Set → Prop

infix:50 (priority := high) " ∈ " => mem

-- Definitions

def not_mem (a b : Set) : Prop :=
¬a ∈ b

infix:50 (priority := high) " ∉ " => not_mem

def empty (a : Set) : Prop :=
¬∃ b, b ∈ a

def nonempty (a : Set) : Prop :=
¬empty a

def is_succ (n1 n : Set) : Prop :=
∀ a, a ∈ n1 ↔ a ∈ n ∨ a = n

def subset (a b : Set) : Prop :=
∀ c, c ∈ a → c ∈ b

infix:50 (priority := high) " ⊆ " => subset

-- Axioms

axiom ax_ext {a b} : (∀ c, c ∈ a ↔ c ∈ b) → a = b
axiom ax_reg {a} : nonempty a → ∃ b, b ∈ a ∧ ¬∃ c, c ∈ b ∧ c ∈ a
axiom ax_spec a (P : Set → Prop) : ∃ b, ∀ c, c ∈ b ↔ c ∈ a ∧ P c
axiom ax_union a : ∃ b, ∀ c d, (d ∈ c ∧ c ∈ a) → d ∈ b
axiom ax_rep a (P : Set → Set → Prop) : (∀ b, b ∈ a → ∃! c, P b c) →
  ∃ b, ∀ c, c ∈ a → ∃ d, d ∈ b ∧ P c d
axiom ax_inf : ∃ a, (∃ b, empty b ∧ b ∈ a) ∧ ∀ c, c ∈ a → ∀ d, is_succ d c → d ∈ a
axiom ax_pow : ∀ a, ∃ b, ∀ c, c ⊆ a → c ∈ b

@[instance] axiom ax_set_inhabited : Inhabited Set

-- Theorems

theorem not_empty {a} : ¬empty a ↔ nonempty a :=
iff_refl

theorem not_nonempty {a} : ¬nonempty a ↔ empty a :=
iff_intro not_not_elim not_not_intro

theorem subset_refl {a} : a ⊆ a :=
λ _ => id

theorem subset_trans {a b c} (h₁ : a ⊆ b) (h₂ : b ⊆ c) : a ⊆ c :=
λ d h₃ => h₂ d # h₁ d h₃

theorem ax_inf' : ∃ a b, empty b ∧ b ∈ a ∧ ∀ c, c ∈ a → ∀ d, is_succ d c → d ∈ a :=
exi_elim ax_inf # λ a h => and_elim h # λ h₁ h₂ => exi_elim h₁ # λ b h₃ =>
exi_intro a # exi_intro b # mp and_assoc # and_intro h₃ h₂


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_10 :
  abs ((120:ℝ) / 100 * 30 - 130 / 100 * 20) = 10 :=
begin
  norm_num,
end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro

! This file was ported from Lean 3 source module linear_algebra.tensor_product
! leanprover-community/mathlib commit b0c712376e4ef44c53c3b872157ef44dfe9f9599
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Congruence
import Mathlib.Algebra.Module.Submodule.Bilinear

/-!
# Tensor product of modules over commutative semirings.

This file constructs the tensor product of modules over commutative semirings. Given a semiring
`R` and modules over it `M` and `N`, the standard construction of the tensor product is
`TensorProduct R M N`. It is also a module over `R`.

It comes with a canonical bilinear map `M → N → TensorProduct R M N`.

Given any bilinear map `M → N → P`, there is a unique linear map `TensorProduct R M N → P` whose
composition with the canonical bilinear map `M → N → TensorProduct R M N` is the given bilinear
map `M → N → P`.

We start by proving basic lemmas about bilinear maps.

## Notations

This file uses the localized notation `M ⊗ N` and `M ⊗[R] N` for `TensorProduct R M N`, as well
as `m ⊗ₜ n` and `m ⊗ₜ[R] n` for `TensorProduct.tmul R m n`.

## Tags

bilinear, tensor, tensor product
-/

section Semiring

variable {R : Type _} [CommSemiring R]
variable {R' : Type _} [Monoid R']
variable {R'' : Type _} [Semiring R'']
variable {M : Type _} {N : Type _} {P : Type _} {Q : Type _} {S : Type _}
variable [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P] [AddCommMonoid Q] [AddCommMonoid S]
variable [Module R M] [Module R N] [Module R P] [Module R Q] [Module R S]
variable [DistribMulAction R' M]
variable [Module R'' M]
variable (M N)

namespace TensorProduct

section

variable (R)

/-- The relation on `FreeAddMonoid (M × N)` that generates a congruence whose quotient is
the tensor product. -/
inductive Eqv : FreeAddMonoid (M × N) → FreeAddMonoid (M × N) → Prop
  | of_zero_left : ∀ n : N, Eqv (.of (0, n)) 0
  | of_zero_right : ∀ m : M, Eqv (.of (m, 0)) 0
  | of_add_left : ∀ (m₁ m₂ : M) (n : N), Eqv (.of (m₁, n) + .of (m₂, n)) (.of (m₁ + m₂, n))
  | of_add_right : ∀ (m : M) (n₁ n₂ : N), Eqv (.of (m, n₁) + .of (m, n₂)) (.of (m, n₁ + n₂))
  | of_smul : ∀ (r : R) (m : M) (n : N), Eqv (.of (r • m, n)) (.of (m, r • n))
  | add_comm : ∀ x y, Eqv (x + y) (y + x)
#align tensor_product.eqv TensorProduct.Eqv

end

end TensorProduct

variable (R)

/-- The tensor product of two modules `M` and `N` over the same commutative semiring `R`.
The localized notations are `M ⊗ N` and `M ⊗[R] N`, accessed by `open scoped TensorProduct`. -/
def TensorProduct : Type _ :=
  (addConGen (TensorProduct.Eqv R M N)).Quotient
#align tensor_product TensorProduct

variable {R}

set_option quotPrecheck false in
scoped[TensorProduct] infixl:100 " ⊗ " => TensorProduct _

scoped[TensorProduct] notation:100 M " ⊗[" R "] " N:100 => TensorProduct R M N

namespace TensorProduct

section Module

-- porting note: This is added as a local instance for `SMul.aux`.
-- For some reason type-class inference in Lean 3 unfolded this definition.
def addMonoid : AddMonoid (M ⊗[R] N) :=
  { (addConGen (TensorProduct.Eqv R M N)).addMonoid with }

instance addZeroClass : AddZeroClass (M ⊗[R] N) :=
  { (addConGen (TensorProduct.Eqv R M N)).addMonoid with }

instance addCommSemigroup : AddCommSemigroup (M ⊗[R] N) :=
  { (addConGen (TensorProduct.Eqv R M N)).addMonoid with
    add_comm := fun x y =>
      AddCon.induction_on₂ x y fun _ _ =>
        Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.add_comm _ _ }

instance : Inhabited (M ⊗[R] N) :=
  ⟨0⟩

variable (R) {M N}

/-- The canonical function `M → N → M ⊗ N`. The localized notations are `m ⊗ₜ n` and `m ⊗ₜ[R] n`,
accessed by `open scoped TensorProduct`. -/
def tmul (m : M) (n : N) : M ⊗[R] N :=
  AddCon.mk' _ <| FreeAddMonoid.of (m, n)
#align tensor_product.tmul TensorProduct.tmul

variable {R}

infixl:100 " ⊗ₜ " => tmul _

notation:100 x " ⊗ₜ[" R "] " y:100 => tmul R x y

-- porting note: make the arguments of induction_on explicit
@[elab_as_elim]
protected theorem induction_on {C : M ⊗[R] N → Prop} (z : M ⊗[R] N) (C0 : C 0)
    (C1 : ∀ x y, C <| x ⊗ₜ[R] y) (Cp : ∀ x y, C x → C y → C (x + y)) : C z :=
  AddCon.induction_on z fun x =>
    FreeAddMonoid.recOn x C0 fun ⟨m, n⟩ y ih => by
      rw [AddCon.coe_add]
      exact Cp _ _ (C1 ..) ih
#align tensor_product.induction_on TensorProduct.induction_on

variable (M)

@[simp]
theorem zero_tmul (n : N) : (0 : M) ⊗ₜ[R] n = 0 :=
  Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.of_zero_left _
#align tensor_product.zero_tmul TensorProduct.zero_tmul

variable {M}

theorem add_tmul (m₁ m₂ : M) (n : N) : (m₁ + m₂) ⊗ₜ n = m₁ ⊗ₜ n + m₂ ⊗ₜ[R] n :=
  Eq.symm <| Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.of_add_left _ _ _
#align tensor_product.add_tmul TensorProduct.add_tmul

variable (N)

@[simp]
theorem tmul_zero (m : M) : m ⊗ₜ[R] (0 : N) = 0 :=
  Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.of_zero_right _
#align tensor_product.tmul_zero TensorProduct.tmul_zero

variable {N}

theorem tmul_add (m : M) (n₁ n₂ : N) : m ⊗ₜ (n₁ + n₂) = m ⊗ₜ n₁ + m ⊗ₜ[R] n₂ :=
  Eq.symm <| Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.of_add_right _ _ _
#align tensor_product.tmul_add TensorProduct.tmul_add

section

variable (R R' M N)

/-- A typeclass for `SMul` structures which can be moved across a tensor product.

This typeclass is generated automatically from a `IsScalarTower` instance, but exists so that
we can also add an instance for `AddCommGroup.intModule`, allowing `z •` to be moved even if
`R` does not support negation.

Note that `Module R' (M ⊗[R] N)` is available even without this typeclass on `R'`; it's only
needed if `TensorProduct.smul_tmul`, `TensorProduct.smul_tmul'`, or `TensorProduct.tmul_smul` is
used.
-/
class CompatibleSMul [DistribMulAction R' N] where
  smul_tmul : ∀ (r : R') (m : M) (n : N), (r • m) ⊗ₜ n = m ⊗ₜ[R] (r • n)
#align tensor_product.compatible_smul TensorProduct.CompatibleSMul

end

/-- Note that this provides the default `compatible_smul R R M N` instance through
`IsScalarTower.left`. -/
instance (priority := 100) CompatibleSMul.isScalarTower [SMul R' R] [IsScalarTower R' R M]
    [DistribMulAction R' N] [IsScalarTower R' R N] : CompatibleSMul R R' M N :=
  ⟨fun r m n => by
    conv_lhs => rw [← one_smul R m]
    conv_rhs => rw [← one_smul R n]
    rw [← smul_assoc, ← smul_assoc]
    exact Quotient.sound' <| AddConGen.Rel.of _ _ <| Eqv.of_smul _ _ _⟩
#align tensor_product.compatible_smul.is_scalar_tower TensorProduct.CompatibleSMul.isScalarTower

/-- `smul` can be moved from one side of the product to the other .-/
theorem smul_tmul [DistribMulAction R' N] [CompatibleSMul R R' M N] (r : R') (m : M) (n : N) :
    (r • m) ⊗ₜ n = m ⊗ₜ[R] (r • n) :=
  CompatibleSMul.smul_tmul _ _ _
#align tensor_product.smul_tmul TensorProduct.smul_tmul

attribute [local instance] addMonoid
/-- Auxiliary function to defining scalar multiplication on tensor product. -/
def SMul.aux {R' : Type _} [SMul R' M] (r : R') : FreeAddMonoid (M × N) →+ M ⊗[R] N :=
  FreeAddMonoid.lift fun p : M × N => (r • p.1) ⊗ₜ p.2
#align tensor_product.smul.aux TensorProduct.SMul.aux
attribute [-instance] addMonoid

theorem SMul.aux_of {R' : Type _} [SMul R' M] (r : R') (m : M) (n : N) :
    SMul.aux r (.of (m, n)) = (r • m) ⊗ₜ[R] n :=
  rfl
#align tensor_product.smul.aux_of TensorProduct.SMul.aux_of

variable [SMulCommClass R R' M] [SMulCommClass R R'' M]

/-- Given two modules over a commutative semiring `R`, if one of the factors carries a
(distributive) action of a second type of scalars `R'`, which commutes with the action of `R`, then
the tensor product (over `R`) carries an action of `R'`.

This instance defines this `R'` action in the case that it is the left module which has the `R'`
action. Two natural ways in which this situation arises are:
 * Extension of scalars
 * A tensor product of a group representation with a module not carrying an action

Note that in the special case that `R = R'`, since `R` is commutative, we just get the usual scalar
action on a tensor product of two modules. This special case is important enough that, for
performance reasons, we define it explicitly below. -/
instance leftHasSMul : SMul R' (M ⊗[R] N) :=
  ⟨fun r =>
    (addConGen (TensorProduct.Eqv R M N)).lift (SMul.aux r : _ →+ M ⊗[R] N) <|
      AddCon.addConGen_le fun x y hxy =>
        match x, y, hxy with
        | _, _, .of_zero_left n =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_zero, SMul.aux_of, smul_zero, zero_tmul]
        | _, _, .of_zero_right m =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_zero, SMul.aux_of, tmul_zero]
        | _, _, .of_add_left m₁ m₂ n =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, SMul.aux_of, smul_add, add_tmul]
        | _, _, .of_add_right m n₁ n₂ =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, SMul.aux_of, tmul_add]
        | _, _, .of_smul s m n =>
          (AddCon.ker_rel _).2 <| by rw [SMul.aux_of, SMul.aux_of, ← smul_comm, smul_tmul]
        | _, _, .add_comm x y =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, add_comm]⟩
#align tensor_product.left_has_smul TensorProduct.leftHasSMul

instance : SMul R (M ⊗[R] N) :=
  TensorProduct.leftHasSMul

protected theorem smul_zero (r : R') : r • (0 : M ⊗[R] N) = 0 :=
  AddMonoidHom.map_zero _
#align tensor_product.smul_zero TensorProduct.smul_zero

protected theorem smul_add (r : R') (x y : M ⊗[R] N) : r • (x + y) = r • x + r • y :=
  AddMonoidHom.map_add _ _ _
#align tensor_product.smul_add TensorProduct.smul_add

protected theorem zero_smul (x : M ⊗[R] N) : (0 : R'') • x = 0 :=
  have : ∀ (r : R'') (m : M) (n : N), r • m ⊗ₜ[R] n = (r • m) ⊗ₜ n := fun _ _ _ => rfl
  x.induction_on (by rw [TensorProduct.smul_zero])
    (fun m n => by rw [this, zero_smul, zero_tmul]) fun x y ihx ihy => by
    rw [TensorProduct.smul_add, ihx, ihy, add_zero]
#align tensor_product.zero_smul TensorProduct.zero_smul

protected theorem one_smul (x : M ⊗[R] N) : (1 : R') • x = x :=
  have : ∀ (r : R') (m : M) (n : N), r • m ⊗ₜ[R] n = (r • m) ⊗ₜ n := fun _ _ _ => rfl
  x.induction_on (by rw [TensorProduct.smul_zero])
    (fun m n => by rw [this, one_smul])
    fun x y ihx ihy => by rw [TensorProduct.smul_add, ihx, ihy]
#align tensor_product.one_smul TensorProduct.one_smul

protected theorem add_smul (r s : R'') (x : M ⊗[R] N) : (r + s) • x = r • x + s • x :=
  have : ∀ (r : R'') (m : M) (n : N), r • m ⊗ₜ[R] n = (r • m) ⊗ₜ n := fun _ _ _ => rfl
  x.induction_on (by simp_rw [TensorProduct.smul_zero, add_zero])
    (fun m n => by simp_rw [this, add_smul, add_tmul]) fun x y ihx ihy => by
    simp_rw [TensorProduct.smul_add]
    rw [ihx, ihy, add_add_add_comm]
#align tensor_product.add_smul TensorProduct.add_smul

instance addCommMonoid : AddCommMonoid (M ⊗[R] N) :=
  { TensorProduct.addCommSemigroup _ _,
    TensorProduct.addZeroClass _ _ with
    nsmul := fun n v => n • v
    nsmul_zero := by simp [TensorProduct.zero_smul]
    nsmul_succ := by simp only [TensorProduct.one_smul, TensorProduct.add_smul, add_comm,
      forall_const] }

instance leftDistribMulAction : DistribMulAction R' (M ⊗[R] N) :=
  have : ∀ (r : R') (m : M) (n : N), r • m ⊗ₜ[R] n = (r • m) ⊗ₜ n := fun _ _ _ => rfl
  { smul := (· • ·)
    smul_add := fun r x y => TensorProduct.smul_add r x y
    mul_smul := fun r s x =>
      x.induction_on (by simp_rw [TensorProduct.smul_zero])
        (fun m n => by simp_rw [this, mul_smul]) fun x y ihx ihy => by
        simp_rw [TensorProduct.smul_add]
        rw [ihx, ihy]
    one_smul := TensorProduct.one_smul
    smul_zero := TensorProduct.smul_zero }
#align tensor_product.left_distrib_mul_action TensorProduct.leftDistribMulAction

instance : DistribMulAction R (M ⊗[R] N) :=
  TensorProduct.leftDistribMulAction

theorem smul_tmul' (r : R') (m : M) (n : N) : r • m ⊗ₜ[R] n = (r • m) ⊗ₜ n :=
  rfl
#align tensor_product.smul_tmul' TensorProduct.smul_tmul'

@[simp]
theorem tmul_smul [DistribMulAction R' N] [CompatibleSMul R R' M N] (r : R') (x : M) (y : N) :
    x ⊗ₜ (r • y) = r • x ⊗ₜ[R] y :=
  (smul_tmul _ _ _).symm
#align tensor_product.tmul_smul TensorProduct.tmul_smul

theorem smul_tmul_smul (r s : R) (m : M) (n : N) : (r • m) ⊗ₜ[R] (s • n) = (r * s) • m ⊗ₜ[R] n := by
  simp_rw [smul_tmul, tmul_smul, mul_smul]
#align tensor_product.smul_tmul_smul TensorProduct.smul_tmul_smul

instance leftModule : Module R'' (M ⊗[R] N) :=
  { TensorProduct.leftDistribMulAction with
    smul := (· • ·)
    add_smul := TensorProduct.add_smul
    zero_smul := TensorProduct.zero_smul }
#align tensor_product.left_module TensorProduct.leftModule

instance : Module R (M ⊗[R] N) :=
  TensorProduct.leftModule

instance [Module R''ᵐᵒᵖ M] [IsCentralScalar R'' M] : IsCentralScalar R'' (M ⊗[R] N) where
  op_smul_eq_smul r x :=
    x.induction_on (by rw [smul_zero, smul_zero])
      (fun x y => by rw [smul_tmul', smul_tmul', op_smul_eq_smul]) fun x y hx hy => by
      rw [smul_add, smul_add, hx, hy]

section

-- Like `R'`, `R'₂` provides a `DistribMulAction R'₂ (M ⊗[R] N)`
variable {R'₂ : Type _} [Monoid R'₂] [DistribMulAction R'₂ M]
variable [SMulCommClass R R'₂ M] [SMul R'₂ R']

/-- `IsScalarTower R'₂ R' M` implies `IsScalarTower R'₂ R' (M ⊗[R] N)` -/
instance isScalarTower_left [IsScalarTower R'₂ R' M] : IsScalarTower R'₂ R' (M ⊗[R] N) :=
  ⟨fun s r x =>
    x.induction_on (by simp)
      (fun m n => by rw [smul_tmul', smul_tmul', smul_tmul', smul_assoc]) fun x y ihx ihy => by
      rw [smul_add, smul_add, smul_add, ihx, ihy]⟩
#align tensor_product.is_scalar_tower_left TensorProduct.isScalarTower_left

variable [DistribMulAction R'₂ N] [DistribMulAction R' N]
variable [CompatibleSMul R R'₂ M N] [CompatibleSMul R R' M N]

/-- `IsScalarTower R'₂ R' N` implies `IsScalarTower R'₂ R' (M ⊗[R] N)` -/
instance isScalarTower_right [IsScalarTower R'₂ R' N] : IsScalarTower R'₂ R' (M ⊗[R] N) :=
  ⟨fun s r x =>
    x.induction_on (by simp)
      (fun m n => by rw [← tmul_smul, ← tmul_smul, ← tmul_smul, smul_assoc]) fun x y ihx ihy => by
      rw [smul_add, smul_add, smul_add, ihx, ihy]⟩
#align tensor_product.is_scalar_tower_right TensorProduct.isScalarTower_right

end

/-- A short-cut instance for the common case, where the requirements for the `compatible_smul`
instances are sufficient. -/
instance isScalarTower [SMul R' R] [IsScalarTower R' R M] : IsScalarTower R' R (M ⊗[R] N) :=
  TensorProduct.isScalarTower_left
#align tensor_product.is_scalar_tower TensorProduct.isScalarTower

-- or right
variable (R M N)

/-- The canonical bilinear map `M → N → M ⊗[R] N`. -/
def mk : M →ₗ[R] N →ₗ[R] M ⊗[R] N :=
  LinearMap.mk₂ R (· ⊗ₜ ·) add_tmul (fun c m n => by simp_rw [smul_tmul, tmul_smul])
    tmul_add tmul_smul
#align tensor_product.mk TensorProduct.mk

variable {R M N}

@[simp]
theorem mk_apply (m : M) (n : N) : mk R M N m n = m ⊗ₜ n :=
  rfl
#align tensor_product.mk_apply TensorProduct.mk_apply

theorem ite_tmul (x₁ : M) (x₂ : N) (P : Prop) [Decidable P] :
    (if P then x₁ else 0) ⊗ₜ[R] x₂ = if P then x₁ ⊗ₜ x₂ else 0 := by split_ifs <;> simp
#align tensor_product.ite_tmul TensorProduct.ite_tmul

theorem tmul_ite (x₁ : M) (x₂ : N) (P : Prop) [Decidable P] :
    (x₁ ⊗ₜ[R] if P then x₂ else 0) = if P then x₁ ⊗ₜ x₂ else 0 := by split_ifs <;> simp
#align tensor_product.tmul_ite TensorProduct.tmul_ite

section

open BigOperators

theorem sum_tmul {α : Type _} (s : Finset α) (m : α → M) (n : N) :
    (∑ a in s, m a) ⊗ₜ[R] n = ∑ a in s, m a ⊗ₜ[R] n := by
  classical
    induction' s using Finset.induction with a s has ih h
    · simp
    · simp [Finset.sum_insert has, add_tmul, ih]
#align tensor_product.sum_tmul TensorProduct.sum_tmul

theorem tmul_sum (m : M) {α : Type _} (s : Finset α) (n : α → N) :
    (m ⊗ₜ[R] ∑ a in s, n a) = ∑ a in s, m ⊗ₜ[R] n a := by
  classical
    induction' s using Finset.induction with a s has ih h
    · simp
    · simp [Finset.sum_insert has, tmul_add, ih]
#align tensor_product.tmul_sum TensorProduct.tmul_sum

end

variable (R M N)

/-- The simple (aka pure) elements span the tensor product. -/
theorem span_tmul_eq_top : Submodule.span R { t : M ⊗[R] N | ∃ m n, m ⊗ₜ n = t } = ⊤ := by
  ext t; simp only [Submodule.mem_top, iff_true_iff]
  refine t.induction_on ?_ ?_ ?_
  · exact Submodule.zero_mem _
  · intro m n
    apply Submodule.subset_span
    use m, n
  · intro t₁ t₂ ht₁ ht₂
    exact Submodule.add_mem _ ht₁ ht₂
#align tensor_product.span_tmul_eq_top TensorProduct.span_tmul_eq_top

@[simp]
theorem map₂_mk_top_top_eq_top : Submodule.map₂ (mk R M N) ⊤ ⊤ = ⊤ := by
  rw [← top_le_iff, ← span_tmul_eq_top, Submodule.map₂_eq_span_image2]
  exact Submodule.span_mono fun _ ⟨m, n, h⟩ => ⟨m, n, trivial, trivial, h⟩
#align tensor_product.map₂_mk_top_top_eq_top TensorProduct.map₂_mk_top_top_eq_top

end Module

section UMP

variable {M N}
variable (f : M →ₗ[R] N →ₗ[R] P)

/-- Auxiliary function to constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def liftAux : M ⊗[R] N →+ P :=
  (addConGen (TensorProduct.Eqv R M N)).lift (FreeAddMonoid.lift fun p : M × N => f p.1 p.2) <|
    AddCon.addConGen_le fun x y hxy =>
      match x, y, hxy with
      | _, _, Eqv.of_zero_left n =>
        (AddCon.ker_rel _).2 <| by simp_rw [map_zero, FreeAddMonoid.lift_eval_of, f.map_zero₂]
      | _, _, Eqv.of_zero_right m =>
        (AddCon.ker_rel _).2 <| by simp_rw [map_zero, FreeAddMonoid.lift_eval_of, (f m).map_zero]
      | _, _, Eqv.of_add_left m₁ m₂ n =>
        (AddCon.ker_rel _).2 <| by simp_rw [map_add, FreeAddMonoid.lift_eval_of, f.map_add₂]
      | _, _, Eqv.of_add_right m n₁ n₂ =>
        (AddCon.ker_rel _).2 <| by simp_rw [map_add, FreeAddMonoid.lift_eval_of, (f m).map_add]
      | _, _, Eqv.of_smul r m n =>
        (AddCon.ker_rel _).2 <| by simp_rw [FreeAddMonoid.lift_eval_of, f.map_smul₂, (f m).map_smul]
      | _, _, Eqv.add_comm x y =>
        (AddCon.ker_rel _).2 <| by simp_rw [map_add, add_comm]
#align tensor_product.lift_aux TensorProduct.liftAux

theorem liftAux_tmul (m n) : liftAux f (m ⊗ₜ n) = f m n :=
  rfl
#align tensor_product.lift_aux_tmul TensorProduct.liftAux_tmul

variable {f}

@[simp]
theorem liftAux.smul (r : R) (x) : liftAux f (r • x) = r • liftAux f x :=
  TensorProduct.induction_on x (smul_zero _).symm
    (fun p q => by simp_rw [← tmul_smul, liftAux_tmul, (f p).map_smul])
    fun p q ih1 ih2 => by simp_rw [smul_add, (liftAux f).map_add, ih1, ih2, smul_add]
#align tensor_product.lift_aux.smul TensorProduct.liftAux.smul

variable (f)

/-- Constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P` with the property that
its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def lift : M ⊗[R] N →ₗ[R] P :=
  { liftAux f with map_smul' := liftAux.smul }
#align tensor_product.lift TensorProduct.lift

variable {f}

@[simp]
theorem lift.tmul (x y) : lift f (x ⊗ₜ y) = f x y :=
  rfl
#align tensor_product.lift.tmul TensorProduct.lift.tmul

@[simp]
theorem lift.tmul' (x y) : (lift f).1 (x ⊗ₜ y) = f x y :=
  rfl
#align tensor_product.lift.tmul' TensorProduct.lift.tmul'

theorem ext' {g h : M ⊗[R] N →ₗ[R] P} (H : ∀ x y, g (x ⊗ₜ y) = h (x ⊗ₜ y)) : g = h :=
  LinearMap.ext fun z =>
    TensorProduct.induction_on z (by simp_rw [LinearMap.map_zero]) H fun x y ihx ihy => by
      rw [g.map_add, h.map_add, ihx, ihy]
#align tensor_product.ext' TensorProduct.ext'

theorem lift.unique {g : M ⊗[R] N →ₗ[R] P} (H : ∀ x y, g (x ⊗ₜ y) = f x y) : g = lift f :=
  ext' fun m n => by rw [H, lift.tmul]
#align tensor_product.lift.unique TensorProduct.lift.unique

theorem lift_mk : lift (mk R M N) = LinearMap.id :=
  Eq.symm <| lift.unique fun _ _ => rfl
#align tensor_product.lift_mk TensorProduct.lift_mk

theorem lift_mk_compr₂ (f : M ⊗ N →ₗ[R] P) : lift ((mk R M N).compr₂ f) = f := by
  rw [lift_compr₂ f, lift_mk, LinearMap.comp_id]
#align tensor_product.lift_mk_compr₂ TensorProduct.lift_mk_compr₂

/-- This used to be an `@[ext]` lemma, but it fails very slowly when the `ext` tactic tries to apply
it in some cases, notably when one wants to show equality of two linear maps. The `@[ext]`
attribute is now added locally where it is needed. Using this as the `@[ext]` lemma instead of
`TensorProduct.ext'` allows `ext` to apply lemmas specific to `M →ₗ _` and `N →ₗ _`.

See note [partially-applied ext lemmas]. -/
theorem ext {g h : M ⊗ N →ₗ[R] P} (H : (mk R M N).compr₂ g = (mk R M N).compr₂ h) : g = h := by
  rw [← lift_mk_compr₂ g, H, lift_mk_compr₂]
#align tensor_product.ext TensorProduct.ext

attribute [local ext high] ext

example : M → N → (M → N → P) → P := fun m => flip fun f => f m

variable (R M N P)

/-- Linearly constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def uncurry : (M →ₗ[R] N →ₗ[R] P) →ₗ[R] M ⊗[R] N →ₗ[R] P :=
  LinearMap.flip <| lift <| LinearMap.lflip.comp (LinearMap.flip LinearMap.id)
#align tensor_product.uncurry TensorProduct.uncurry

variable {R M N P}

@[simp]
theorem uncurry_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) :
    uncurry R M N P f (m ⊗ₜ n) = f m n := by rw [uncurry, LinearMap.flip_apply, lift.tmul]; rfl
#align tensor_product.uncurry_apply TensorProduct.uncurry_apply

variable (R M N P)

/-- A linear equivalence constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def lift.equiv : (M →ₗ[R] N →ₗ[R] P) ≃ₗ[R] M ⊗[R] N →ₗ[R] P :=
  { uncurry R M N P with
    invFun := fun f => (mk R M N).compr₂ f
    left_inv := fun _ => LinearMap.ext₂ fun _ _ => lift.tmul _ _
    right_inv := fun _ => ext' fun _ _ => lift.tmul _ _ }
#align tensor_product.lift.equiv TensorProduct.lift.equiv

@[simp]
theorem lift.equiv_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) :
    lift.equiv R M N P f (m ⊗ₜ n) = f m n :=
  uncurry_apply f m n
#align tensor_product.lift.equiv_apply TensorProduct.lift.equiv_apply

@[simp]
theorem lift.equiv_symm_apply (f : M ⊗[R] N →ₗ[R] P) (m : M) (n : N) :
    (lift.equiv R M N P).symm f m n = f (m ⊗ₜ n) :=
  rfl
#align tensor_product.lift.equiv_symm_apply TensorProduct.lift.equiv_symm_apply

/-- Given a linear map `M ⊗ N → P`, compose it with the canonical bilinear map `M → N → M ⊗ N` to
form a bilinear map `M → N → P`. -/
def lcurry : (M ⊗[R] N →ₗ[R] P) →ₗ[R] M →ₗ[R] N →ₗ[R] P :=
  (lift.equiv R M N P).symm
#align tensor_product.lcurry TensorProduct.lcurry

variable {R M N P}

@[simp]
theorem lcurry_apply (f : M ⊗[R] N →ₗ[R] P) (m : M) (n : N) : lcurry R M N P f m n = f (m ⊗ₜ n) :=
  rfl
#align tensor_product.lcurry_apply TensorProduct.lcurry_apply

/-- Given a linear map `M ⊗ N → P`, compose it with the canonical bilinear map `M → N → M ⊗ N` to
form a bilinear map `M → N → P`. -/
def curry (f : M ⊗[R] N →ₗ[R] P) : M →ₗ[R] N →ₗ[R] P :=
  lcurry R M N P f
#align tensor_product.curry TensorProduct.curry

@[simp]
theorem curry_apply (f : M ⊗ N →ₗ[R] P) (m : M) (n : N) : curry f m n = f (m ⊗ₜ n) :=
  rfl
#align tensor_product.curry_apply TensorProduct.curry_apply

theorem curry_injective : Function.Injective (curry : (M ⊗[R] N →ₗ[R] P) → M →ₗ[R] N →ₗ[R] P) :=
  fun _ _ H => ext H
#align tensor_product.curry_injective TensorProduct.curry_injective

theorem ext_threefold {g h : (M ⊗[R] N) ⊗[R] P →ₗ[R] Q}
    (H : ∀ x y z, g (x ⊗ₜ y ⊗ₜ z) = h (x ⊗ₜ y ⊗ₜ z)) : g = h := by
  ext x y z
  exact H x y z
#align tensor_product.ext_threefold TensorProduct.ext_threefold

-- We'll need this one for checking the pentagon identity!
theorem ext_fourfold {g h : ((M ⊗[R] N) ⊗[R] P) ⊗[R] Q →ₗ[R] S}
    (H : ∀ w x y z, g (w ⊗ₜ x ⊗ₜ y ⊗ₜ z) = h (w ⊗ₜ x ⊗ₜ y ⊗ₜ z)) : g = h := by
  ext w x y z
  exact H w x y z
#align tensor_product.ext_fourfold TensorProduct.ext_fourfold

/-- Two linear maps (M ⊗ N) ⊗ (P ⊗ Q) → S which agree on all elements of the
form (m ⊗ₜ n) ⊗ₜ (p ⊗ₜ q) are equal. -/
theorem ext_fourfold' {φ ψ : (M ⊗[R] N) ⊗[R] P ⊗[R] Q →ₗ[R] S}
    (H : ∀ w x y z, φ (w ⊗ₜ x ⊗ₜ (y ⊗ₜ z)) = ψ (w ⊗ₜ x ⊗ₜ (y ⊗ₜ z))) : φ = ψ := by
  ext m n p q
  exact H m n p q
#align tensor_product.ext_fourfold' TensorProduct.ext_fourfold'

end UMP

variable {M N}

section

variable (R M)

/-- The base ring is a left identity for the tensor product of modules, up to linear equivalence.
-/
protected def lid : R ⊗[R] M ≃ₗ[R] M :=
  LinearEquiv.ofLinear (lift <| LinearMap.lsmul R M) (mk R R M 1) (LinearMap.ext fun _ => by simp)
    (ext' fun r m => by simp; rw [← tmul_smul, ← smul_tmul, smul_eq_mul, mul_one])
#align tensor_product.lid TensorProduct.lid

end

@[simp]
theorem lid_tmul (m : M) (r : R) : (TensorProduct.lid R M : R ⊗ M → M) (r ⊗ₜ m) = r • m :=
  rfl
#align tensor_product.lid_tmul TensorProduct.lid_tmul

@[simp]
theorem lid_symm_apply (m : M) : (TensorProduct.lid R M).symm m = 1 ⊗ₜ m :=
  rfl
#align tensor_product.lid_symm_apply TensorProduct.lid_symm_apply

section

variable (R M N)

/-- The tensor product of modules is commutative, up to linear equivalence.
-/
protected def comm : M ⊗[R] N ≃ₗ[R] N ⊗[R] M :=
  LinearEquiv.ofLinear (lift (mk R N M).flip) (lift (mk R M N).flip) (ext' fun _ _ => rfl)
    (ext' fun _ _ => rfl)
#align tensor_product.comm TensorProduct.comm

@[simp]
theorem comm_tmul (m : M) (n : N) : (TensorProduct.comm R M N) (m ⊗ₜ n) = n ⊗ₜ m :=
  rfl
#align tensor_product.comm_tmul TensorProduct.comm_tmul

@[simp]
theorem comm_symm_tmul (m : M) (n : N) : (TensorProduct.comm R M N).symm (n ⊗ₜ m) = m ⊗ₜ n :=
  rfl
#align tensor_product.comm_symm_tmul TensorProduct.comm_symm_tmul

end

section

variable (R M)

/-- The base ring is a right identity for the tensor product of modules, up to linear equivalence.
-/
protected def rid : M ⊗[R] R ≃ₗ[R] M :=
  LinearEquiv.trans (TensorProduct.comm R M R) (TensorProduct.lid R M)
#align tensor_product.rid TensorProduct.rid

end

@[simp]
theorem rid_tmul (m : M) (r : R) : (TensorProduct.rid R M) (m ⊗ₜ r) = r • m :=
  rfl
#align tensor_product.rid_tmul TensorProduct.rid_tmul

@[simp]
theorem rid_symm_apply (m : M) : (TensorProduct.rid R M).symm m = m ⊗ₜ 1 :=
  rfl
#align tensor_product.rid_symm_apply TensorProduct.rid_symm_apply

open LinearMap

section

variable (R M N P)

/-- The associator for tensor product of R-modules, as a linear equivalence. -/
protected def assoc : (M ⊗[R] N) ⊗[R] P ≃ₗ[R] M ⊗[R] N ⊗[R] P := by
  refine
      LinearEquiv.ofLinear (lift <| lift <| comp (lcurry R _ _ _) <| mk _ _ _)
        (lift <| comp (uncurry R _ _ _) <| curry <| mk _ _ _)
        (ext <| LinearMap.ext fun m => ext' fun n p => ?_)
        (ext <| flip_inj <| LinearMap.ext fun p => ext' fun m n => ?_) <;>
    repeat'
      first
        |rw [lift.tmul]|rw [compr₂_apply]|rw [comp_apply]|rw [mk_apply]|rw [flip_apply]
        |rw [lcurry_apply]|rw [uncurry_apply]|rw [curry_apply]|rw [id_apply]
#align tensor_product.assoc TensorProduct.assoc

end

@[simp]
theorem assoc_tmul (m : M) (n : N) (p : P) :
    (TensorProduct.assoc R M N P) (m ⊗ₜ n ⊗ₜ p) = m ⊗ₜ (n ⊗ₜ p) :=
  rfl
#align tensor_product.assoc_tmul TensorProduct.assoc_tmul

@[simp]
theorem assoc_symm_tmul (m : M) (n : N) (p : P) :
    (TensorProduct.assoc R M N P).symm (m ⊗ₜ (n ⊗ₜ p)) = m ⊗ₜ n ⊗ₜ p :=
  rfl
#align tensor_product.assoc_symm_tmul TensorProduct.assoc_symm_tmul

/-- The tensor product of a pair of linear maps between modules. -/
def map (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : M ⊗[R] N →ₗ[R] P ⊗[R] Q :=
  lift <| comp (compl₂ (mk _ _ _) g) f
#align tensor_product.map TensorProduct.map

@[simp]
theorem map_tmul (f : M →ₗ[R] P) (g : N →ₗ[R] Q) (m : M) (n : N) : map f g (m ⊗ₜ n) = f m ⊗ₜ g n :=
  rfl
#align tensor_product.map_tmul TensorProduct.map_tmul

theorem map_range_eq_span_tmul (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    range (map f g) = Submodule.span R { t | ∃ m n, f m ⊗ₜ g n = t } := by
  simp only [← Submodule.map_top, ← span_tmul_eq_top, Submodule.map_span, Set.mem_image,
    Set.mem_setOf_eq]
  congr ; ext t
  constructor
  · rintro ⟨_, ⟨⟨m, n, rfl⟩, rfl⟩⟩
    use m, n
    simp only [map_tmul]
  · rintro ⟨m, n, rfl⟩
    refine ⟨_, ⟨⟨m, n, rfl⟩, ?_⟩⟩
    simp only [map_tmul]
#align tensor_product.map_range_eq_span_tmul TensorProduct.map_range_eq_span_tmul

/-- Given submodules `p ⊆ P` and `q ⊆ Q`, this is the natural map: `p ⊗ q → P ⊗ Q`. -/
@[simp]
def mapIncl (p : Submodule R P) (q : Submodule R Q) : p ⊗[R] q →ₗ[R] P ⊗[R] Q :=
  map p.subtype q.subtype
#align tensor_product.map_incl TensorProduct.mapIncl

section

variable {P' Q' : Type _}
variable [AddCommMonoid P'] [Module R P']
variable [AddCommMonoid Q'] [Module R Q']

theorem map_comp (f₂ : P →ₗ[R] P') (f₁ : M →ₗ[R] P) (g₂ : Q →ₗ[R] Q') (g₁ : N →ₗ[R] Q) :
    map (f₂.comp f₁) (g₂.comp g₁) = (map f₂ g₂).comp (map f₁ g₁) :=
  ext' fun _ _ => rfl
#align tensor_product.map_comp TensorProduct.map_comp

theorem lift_comp_map (i : P →ₗ[R] Q →ₗ[R] Q') (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    (lift i).comp (map f g) = lift ((i.comp f).compl₂ g) :=
  ext' fun _ _ => rfl
#align tensor_product.lift_comp_map TensorProduct.lift_comp_map

attribute [local ext high] ext

@[simp]
theorem map_id : map (id : M →ₗ[R] M) (id : N →ₗ[R] N) = .id := by
  ext
  simp only [mk_apply, id_coe, compr₂_apply, id.def, map_tmul]
#align tensor_product.map_id TensorProduct.map_id

@[simp]
theorem map_one : map (1 : M →ₗ[R] M) (1 : N →ₗ[R] N) = 1 :=
  map_id
#align tensor_product.map_one TensorProduct.map_one

theorem map_mul (f₁ f₂ : M →ₗ[R] M) (g₁ g₂ : N →ₗ[R] N) :
    map (f₁ * f₂) (g₁ * g₂) = map f₁ g₁ * map f₂ g₂ :=
  map_comp f₁ f₂ g₁ g₂
#align tensor_product.map_mul TensorProduct.map_mul

@[simp]
protected theorem map_pow (f : M →ₗ[R] M) (g : N →ₗ[R] N) (n : ℕ) :
    map f g ^ n = map (f ^ n) (g ^ n) := by
  induction' n with n ih
  · simp only [Nat.zero_eq, pow_zero, map_one]
  · simp only [pow_succ', ih, map_mul]
#align tensor_product.map_pow TensorProduct.map_pow

theorem map_add_left (f₁ f₂ : M →ₗ[R] P) (g : N →ₗ[R] Q) :
  map (f₁ + f₂) g = map f₁ g + map f₂ g := by
  ext
  simp only [add_tmul, compr₂_apply, mk_apply, map_tmul, add_apply]
#align tensor_product.map_add_left TensorProduct.map_add_left

theorem map_add_right (f : M →ₗ[R] P) (g₁ g₂ : N →ₗ[R] Q) :
  map f (g₁ + g₂) = map f g₁ + map f g₂ := by
  ext
  simp only [tmul_add, compr₂_apply, mk_apply, map_tmul, add_apply]
#align tensor_product.map_add_right TensorProduct.map_add_right

theorem map_smul_left (r : R) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : map (r • f) g = r • map f g := by
  ext
  simp only [smul_tmul, compr₂_apply, mk_apply, map_tmul, smul_apply, tmul_smul]
#align tensor_product.map_smul_left TensorProduct.map_smul_left

theorem map_smul_right (r : R) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : map f (r • g) = r • map f g := by
  ext
  simp only [smul_tmul, compr₂_apply, mk_apply, map_tmul, smul_apply, tmul_smul]
#align tensor_product.map_smul_right TensorProduct.map_smul_right

variable (R M N P Q)

/-- The tensor product of a pair of linear maps between modules, bilinear in both maps. -/
def mapBilinear : (M →ₗ[R] P) →ₗ[R] (N →ₗ[R] Q) →ₗ[R] M ⊗[R] N →ₗ[R] P ⊗[R] Q :=
  LinearMap.mk₂ R map map_add_left map_smul_left map_add_right map_smul_right
#align tensor_product.map_bilinear TensorProduct.mapBilinear

/-- The canonical linear map from `P ⊗[R] (M →ₗ[R] Q)` to `(M →ₗ[R] P ⊗[R] Q)` -/
def ltensorHomToHomLtensor : P ⊗[R] (M →ₗ[R] Q) →ₗ[R] M →ₗ[R] P ⊗[R] Q :=
  TensorProduct.lift (llcomp R M Q _ ∘ₗ mk R P Q)
#align tensor_product.ltensor_hom_to_hom_ltensor TensorProduct.ltensorHomToHomLtensor

/-- The canonical linear map from `(M →ₗ[R] P) ⊗[R] Q` to `(M →ₗ[R] P ⊗[R] Q)` -/
def rtensorHomToHomRtensor : (M →ₗ[R] P) ⊗[R] Q →ₗ[R] M →ₗ[R] P ⊗[R] Q :=
  TensorProduct.lift (llcomp R M P _ ∘ₗ (mk R P Q).flip).flip
#align tensor_product.rtensor_hom_to_hom_rtensor TensorProduct.rtensorHomToHomRtensor

/-- The linear map from `(M →ₗ P) ⊗ (N →ₗ Q)` to `(M ⊗ N →ₗ P ⊗ Q)` sending `f ⊗ₜ g` to
the `TensorProduct.map f g`, the tensor product of the two maps. -/
def homTensorHomMap : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q) →ₗ[R] M ⊗[R] N →ₗ[R] P ⊗[R] Q :=
  lift (mapBilinear R M N P Q)
#align tensor_product.hom_tensor_hom_map TensorProduct.homTensorHomMap

variable {R M N P Q}

@[simp]
theorem mapBilinear_apply (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : mapBilinear R M N P Q f g = map f g :=
  rfl
#align tensor_product.map_bilinear_apply TensorProduct.mapBilinear_apply

@[simp]
theorem ltensorHomToHomLtensor_apply (p : P) (f : M →ₗ[R] Q) (m : M) :
    ltensorHomToHomLtensor R M P Q (p ⊗ₜ f) m = p ⊗ₜ f m :=
  rfl
#align tensor_product.ltensor_hom_to_hom_ltensor_apply TensorProduct.ltensorHomToHomLtensor_apply

@[simp]
theorem rtensorHomToHomRtensor_apply (f : M →ₗ[R] P) (q : Q) (m : M) :
    rtensorHomToHomRtensor R M P Q (f ⊗ₜ q) m = f m ⊗ₜ q :=
  rfl
#align tensor_product.rtensor_hom_to_hom_rtensor_apply TensorProduct.rtensorHomToHomRtensor_apply

@[simp]
theorem homTensorHomMap_apply (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    homTensorHomMap R M N P Q (f ⊗ₜ g) = map f g :=
  rfl
#align tensor_product.hom_tensor_hom_map_apply TensorProduct.homTensorHomMap_apply

end

/-- If `M` and `P` are linearly equivalent and `N` and `Q` are linearly equivalent
then `M ⊗ N` and `P ⊗ Q` are linearly equivalent. -/
def congr (f : M ≃ₗ[R] P) (g : N ≃ₗ[R] Q) : M ⊗[R] N ≃ₗ[R] P ⊗[R] Q :=
  LinearEquiv.ofLinear (map f g) (map f.symm g.symm)
    (ext' fun m n => by simp)
    (ext' fun m n => by simp)
#align tensor_product.congr TensorProduct.congr

@[simp]
theorem congr_tmul (f : M ≃ₗ[R] P) (g : N ≃ₗ[R] Q) (m : M) (n : N) :
    congr f g (m ⊗ₜ n) = f m ⊗ₜ g n :=
  rfl
#align tensor_product.congr_tmul TensorProduct.congr_tmul

@[simp]
theorem congr_symm_tmul (f : M ≃ₗ[R] P) (g : N ≃ₗ[R] Q) (p : P) (q : Q) :
    (congr f g).symm (p ⊗ₜ q) = f.symm p ⊗ₜ g.symm q :=
  rfl
#align tensor_product.congr_symm_tmul TensorProduct.congr_symm_tmul

variable (R M N P Q)

/-- A tensor product analogue of `mul_left_comm`. -/
def leftComm : M ⊗[R] N ⊗[R] P ≃ₗ[R] N ⊗[R] M ⊗[R] P :=
  let e₁ := (TensorProduct.assoc R M N P).symm
  let e₂ := congr (TensorProduct.comm R M N) (1 : P ≃ₗ[R] P)
  let e₃ := TensorProduct.assoc R N M P
  e₁ ≪≫ₗ (e₂ ≪≫ₗ e₃)
#align tensor_product.left_comm TensorProduct.leftComm

variable {M N P Q}

@[simp]
theorem leftComm_tmul (m : M) (n : N) (p : P) : leftComm R M N P (m ⊗ₜ (n ⊗ₜ p)) = n ⊗ₜ (m ⊗ₜ p) :=
  rfl
#align tensor_product.left_comm_tmul TensorProduct.leftComm_tmul

@[simp]
theorem leftComm_symm_tmul (m : M) (n : N) (p : P) :
    (leftComm R M N P).symm (n ⊗ₜ (m ⊗ₜ p)) = m ⊗ₜ (n ⊗ₜ p) :=
  rfl
#align tensor_product.left_comm_symm_tmul TensorProduct.leftComm_symm_tmul

variable (M N P Q)

/-- This special case is worth defining explicitly since it is useful for defining multiplication
on tensor products of modules carrying multiplications (e.g., associative rings, Lie rings, ...).

E.g., suppose `M = P` and `N = Q` and that `M` and `N` carry bilinear multiplications:
`M ⊗ M → M` and `N ⊗ N → N`. Using `map`, we can define `(M ⊗ M) ⊗ (N ⊗ N) → M ⊗ N` which, when
combined with this definition, yields a bilinear multiplication on `M ⊗ N`:
`(M ⊗ N) ⊗ (M ⊗ N) → M ⊗ N`. In particular we could use this to define the multiplication in
the `TensorProduct.semiring` instance (currently defined "by hand" using `TensorProduct.mul`).

See also `mul_mul_mul_comm`. -/
def tensorTensorTensorComm : (M ⊗[R] N) ⊗[R] P ⊗[R] Q ≃ₗ[R] (M ⊗[R] P) ⊗[R] N ⊗[R] Q :=
  let e₁ := TensorProduct.assoc R M N (P ⊗[R] Q)
  let e₂ := congr (1 : M ≃ₗ[R] M) (leftComm R N P Q)
  let e₃ := (TensorProduct.assoc R M P (N ⊗[R] Q)).symm
  e₁ ≪≫ₗ (e₂ ≪≫ₗ e₃)
#align tensor_product.tensor_tensor_tensor_comm TensorProduct.tensorTensorTensorComm

variable {M N P Q}

@[simp]
theorem tensorTensorTensorComm_tmul (m : M) (n : N) (p : P) (q : Q) :
    tensorTensorTensorComm R M N P Q (m ⊗ₜ n ⊗ₜ (p ⊗ₜ q)) = m ⊗ₜ p ⊗ₜ (n ⊗ₜ q) :=
  rfl
#align tensor_product.tensor_tensor_tensor_comm_tmul TensorProduct.tensorTensorTensorComm_tmul

-- porting note: the proof here was `rfl` but that caused a timeout.
@[simp]
theorem tensorTensorTensorComm_symm :
    (tensorTensorTensorComm R M N P Q).symm = tensorTensorTensorComm R M P N Q :=
  by ext; rfl
#align tensor_product.tensor_tensor_tensor_comm_symm TensorProduct.tensorTensorTensorComm_symm

variable (M N P Q)

/-- This special case is useful for describing the interplay between `dual_tensor_hom_equiv` and
composition of linear maps.

E.g., composition of linear maps gives a map `(M → N) ⊗ (N → P) → (M → P)`, and applying
`dual_tensor_hom_equiv.symm` to the three hom-modules gives a map
`(M.dual ⊗ N) ⊗ (N.dual ⊗ P) → (M.dual ⊗ P)`, which agrees with the application of `contract_right`
on `N ⊗ N.dual` after the suitable rebracketting.
-/
def tensorTensorTensorAssoc : (M ⊗[R] N) ⊗[R] P ⊗[R] Q ≃ₗ[R] (M ⊗[R] N ⊗[R] P) ⊗[R] Q :=
  (TensorProduct.assoc R (M ⊗[R] N) P Q).symm ≪≫ₗ
    congr (TensorProduct.assoc R M N P) (1 : Q ≃ₗ[R] Q)
#align tensor_product.tensor_tensor_tensor_assoc TensorProduct.tensorTensorTensorAssoc

variable {M N P Q}

@[simp]
theorem tensorTensorTensorAssoc_tmul (m : M) (n : N) (p : P) (q : Q) :
    tensorTensorTensorAssoc R M N P Q (m ⊗ₜ n ⊗ₜ (p ⊗ₜ q)) = m ⊗ₜ (n ⊗ₜ p) ⊗ₜ q :=
  rfl
#align tensor_product.tensor_tensor_tensor_assoc_tmul TensorProduct.tensorTensorTensorAssoc_tmul

@[simp]
theorem tensorTensorTensorAssoc_symm_tmul (m : M) (n : N) (p : P) (q : Q) :
    (tensorTensorTensorAssoc R M N P Q).symm (m ⊗ₜ (n ⊗ₜ p) ⊗ₜ q) = m ⊗ₜ n ⊗ₜ (p ⊗ₜ q) :=
  rfl
#align tensor_product.tensor_tensor_tensor_assoc_symm_tmul TensorProduct.tensorTensorTensorAssoc_symm_tmul

end TensorProduct

open scoped TensorProduct
namespace LinearMap

variable {N}

/-- `ltensor M f : M ⊗ N →ₗ M ⊗ P` is the natural linear map induced by `f : N →ₗ P`. -/
def ltensor (f : N →ₗ[R] P) : M ⊗[R] N →ₗ[R] M ⊗[R] P :=
  TensorProduct.map id f
#align linear_map.ltensor LinearMap.ltensor

/-- `rtensor f M : N₁ ⊗ M →ₗ N₂ ⊗ M` is the natural linear map induced by `f : N₁ →ₗ N₂`. -/
def rtensor (f : N →ₗ[R] P) : N ⊗[R] M →ₗ[R] P ⊗[R] M :=
  TensorProduct.map f id
#align linear_map.rtensor LinearMap.rtensor

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

@[simp]
theorem ltensor_tmul (m : M) (n : N) : f.ltensor M (m ⊗ₜ n) = m ⊗ₜ f n :=
  rfl
#align linear_map.ltensor_tmul LinearMap.ltensor_tmul

@[simp]
theorem rtensor_tmul (m : M) (n : N) : f.rtensor M (n ⊗ₜ m) = f n ⊗ₜ m :=
  rfl
#align linear_map.rtensor_tmul LinearMap.rtensor_tmul

open TensorProduct

attribute [local ext high] TensorProduct.ext

/-- `ltensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def ltensorHom : (N →ₗ[R] P) →ₗ[R] M ⊗[R] N →ₗ[R] M ⊗[R] P where
  toFun := ltensor M
  map_add' f g := by
    ext x y
    simp only [compr₂_apply, mk_apply, add_apply, ltensor_tmul, tmul_add]
  map_smul' r f := by
    dsimp
    ext x y
    simp only [compr₂_apply, mk_apply, tmul_smul, smul_apply, ltensor_tmul]
#align linear_map.ltensor_hom LinearMap.ltensorHom

/-- `rtensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def rtensorHom : (N →ₗ[R] P) →ₗ[R] N ⊗[R] M →ₗ[R] P ⊗[R] M where
  toFun f := f.rtensor M
  map_add' f g := by
    ext (x y)
    simp only [compr₂_apply, mk_apply, add_apply, rtensor_tmul, add_tmul]
  map_smul' r f := by
    dsimp
    ext (x y)
    simp only [compr₂_apply, mk_apply, smul_tmul, tmul_smul, smul_apply, rtensor_tmul]
#align linear_map.rtensor_hom LinearMap.rtensorHom

@[simp]
theorem coe_ltensorHom : (ltensorHom M : (N →ₗ[R] P) → M ⊗[R] N →ₗ[R] M ⊗[R] P) = ltensor M :=
  rfl
#align linear_map.coe_ltensor_hom LinearMap.coe_ltensorHom

@[simp]
theorem coe_rtensorHom : (rtensorHom M : (N →ₗ[R] P) → N ⊗[R] M →ₗ[R] P ⊗[R] M) = rtensor M :=
  rfl
#align linear_map.coe_rtensor_hom LinearMap.coe_rtensorHom

@[simp]
theorem ltensor_add (f g : N →ₗ[R] P) : (f + g).ltensor M = f.ltensor M + g.ltensor M :=
  (ltensorHom M).map_add f g
#align linear_map.ltensor_add LinearMap.ltensor_add

@[simp]
theorem rtensor_add (f g : N →ₗ[R] P) : (f + g).rtensor M = f.rtensor M + g.rtensor M :=
  (rtensorHom M).map_add f g
#align linear_map.rtensor_add LinearMap.rtensor_add

@[simp]
theorem ltensor_zero : ltensor M (0 : N →ₗ[R] P) = 0 :=
  (ltensorHom M).map_zero
#align linear_map.ltensor_zero LinearMap.ltensor_zero

@[simp]
theorem rtensor_zero : rtensor M (0 : N →ₗ[R] P) = 0 :=
  (rtensorHom M).map_zero
#align linear_map.rtensor_zero LinearMap.rtensor_zero

@[simp]
theorem ltensor_smul (r : R) (f : N →ₗ[R] P) : (r • f).ltensor M = r • f.ltensor M :=
  (ltensorHom M).map_smul r f
#align linear_map.ltensor_smul LinearMap.ltensor_smul

@[simp]
theorem rtensor_smul (r : R) (f : N →ₗ[R] P) : (r • f).rtensor M = r • f.rtensor M :=
  (rtensorHom M).map_smul r f
#align linear_map.rtensor_smul LinearMap.rtensor_smul

theorem ltensor_comp : (g.comp f).ltensor M = (g.ltensor M).comp (f.ltensor M) := by
  ext (m n)
  simp only [compr₂_apply, mk_apply, comp_apply, ltensor_tmul]
#align linear_map.ltensor_comp LinearMap.ltensor_comp

theorem ltensor_comp_apply (x : M ⊗[R] N) :
    (g.comp f).ltensor M x = (g.ltensor M) ((f.ltensor M) x) := by rw [ltensor_comp, coe_comp]; rfl
#align linear_map.ltensor_comp_apply LinearMap.ltensor_comp_apply

theorem rtensor_comp : (g.comp f).rtensor M = (g.rtensor M).comp (f.rtensor M) := by
  ext (m n)
  simp only [compr₂_apply, mk_apply, comp_apply, rtensor_tmul]
#align linear_map.rtensor_comp LinearMap.rtensor_comp

theorem rtensor_comp_apply (x : N ⊗[R] M) :
    (g.comp f).rtensor M x = (g.rtensor M) ((f.rtensor M) x) := by rw [rtensor_comp, coe_comp]; rfl
#align linear_map.rtensor_comp_apply LinearMap.rtensor_comp_apply

theorem ltensor_mul (f g : Module.End R N) : (f * g).ltensor M = f.ltensor M * g.ltensor M :=
  ltensor_comp M f g
#align linear_map.ltensor_mul LinearMap.ltensor_mul

theorem rtensor_mul (f g : Module.End R N) : (f * g).rtensor M = f.rtensor M * g.rtensor M :=
  rtensor_comp M f g
#align linear_map.rtensor_mul LinearMap.rtensor_mul

variable (N)

@[simp]
theorem ltensor_id : (id : N →ₗ[R] N).ltensor M = id :=
  map_id
#align linear_map.ltensor_id LinearMap.ltensor_id

-- `simp` can prove this.
theorem ltensor_id_apply (x : M ⊗[R] N) : (LinearMap.id : N →ₗ[R] N).ltensor M x = x := by
  rw [ltensor_id, id_coe, id.def]
#align linear_map.ltensor_id_apply LinearMap.ltensor_id_apply

@[simp]
theorem rtensor_id : (id : N →ₗ[R] N).rtensor M = id :=
  map_id
#align linear_map.rtensor_id LinearMap.rtensor_id

-- `simp` can prove this.
theorem rtensor_id_apply (x : N ⊗[R] M) : (LinearMap.id : N →ₗ[R] N).rtensor M x = x := by
  rw [rtensor_id, id_coe, id.def]
#align linear_map.rtensor_id_apply LinearMap.rtensor_id_apply

variable {N}

@[simp]
theorem ltensor_comp_rtensor (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    (g.ltensor P).comp (f.rtensor N) = map f g := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.ltensor_comp_rtensor LinearMap.ltensor_comp_rtensor

@[simp]
theorem rtensor_comp_ltensor (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    (f.rtensor Q).comp (g.ltensor M) = map f g := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.rtensor_comp_ltensor LinearMap.rtensor_comp_ltensor

@[simp]
theorem map_comp_rtensor (f : M →ₗ[R] P) (g : N →ₗ[R] Q) (f' : S →ₗ[R] M) :
    (map f g).comp (f'.rtensor _) = map (f.comp f') g := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.map_comp_rtensor LinearMap.map_comp_rtensor

@[simp]
theorem map_comp_ltensor (f : M →ₗ[R] P) (g : N →ₗ[R] Q) (g' : S →ₗ[R] N) :
    (map f g).comp (g'.ltensor _) = map f (g.comp g') := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.map_comp_ltensor LinearMap.map_comp_ltensor

@[simp]
theorem rtensor_comp_map (f' : P →ₗ[R] S) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    (f'.rtensor _).comp (map f g) = map (f'.comp f) g := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.rtensor_comp_map LinearMap.rtensor_comp_map

@[simp]
theorem ltensor_comp_map (g' : Q →ₗ[R] S) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
    (g'.ltensor _).comp (map f g) = map f (g'.comp g) := by
  simp only [ltensor, rtensor, ← map_comp, id_comp, comp_id]
#align linear_map.ltensor_comp_map LinearMap.ltensor_comp_map

variable {M}

@[simp]
theorem rtensor_pow (f : M →ₗ[R] M) (n : ℕ) : f.rtensor N ^ n = (f ^ n).rtensor N := by
  have h := TensorProduct.map_pow f (id : N →ₗ[R] N) n
  rwa [id_pow] at h
#align linear_map.rtensor_pow LinearMap.rtensor_pow

@[simp]
theorem ltensor_pow (f : N →ₗ[R] N) (n : ℕ) : f.ltensor M ^ n = (f ^ n).ltensor M := by
  have h := TensorProduct.map_pow (id : M →ₗ[R] M) f n
  rwa [id_pow] at h
#align linear_map.ltensor_pow LinearMap.ltensor_pow

end LinearMap

end Semiring

section Ring

variable {R : Type _} [CommSemiring R]
variable {M : Type _} {N : Type _} {P : Type _} {Q : Type _} {S : Type _}
variable [AddCommGroup M] [AddCommGroup N] [AddCommGroup P] [AddCommGroup Q] [AddCommGroup S]
variable [Module R M] [Module R N] [Module R P] [Module R Q] [Module R S]

namespace TensorProduct

open TensorProduct

open LinearMap

variable (R)

/-- Auxiliary function to defining negation multiplication on tensor product. -/
def Neg.aux : FreeAddMonoid (M × N) →+ M ⊗[R] N :=
  FreeAddMonoid.lift fun p : M × N => (-p.1) ⊗ₜ p.2
#align tensor_product.neg.aux TensorProduct.Neg.aux

variable {R}

theorem Neg.aux_of (m : M) (n : N) : Neg.aux R (FreeAddMonoid.of (m, n)) = (-m) ⊗ₜ[R] n :=
  rfl
#align tensor_product.neg.aux_of TensorProduct.Neg.aux_of

instance neg : Neg (M ⊗[R] N) where
  neg :=
    (addConGen (TensorProduct.Eqv R M N)).lift (Neg.aux R) <|
      AddCon.addConGen_le fun x y hxy =>
        match x, y, hxy with
        | _, _, Eqv.of_zero_left n =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_zero, Neg.aux_of, neg_zero, zero_tmul]
        | _, _, Eqv.of_zero_right m =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_zero, Neg.aux_of, tmul_zero]
        | _, _, Eqv.of_add_left m₁ m₂ n =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, Neg.aux_of, neg_add, add_tmul]
        | _, _, Eqv.of_add_right m n₁ n₂ =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, Neg.aux_of, tmul_add]
        | _, _, Eqv.of_smul s m n =>
          (AddCon.ker_rel _).2 <| by simp_rw [Neg.aux_of, ← smul_neg, ← smul_tmul]
        | _, _, Eqv.add_comm x y =>
          (AddCon.ker_rel _).2 <| by simp_rw [map_add, add_comm]

protected theorem add_left_neg (x : M ⊗[R] N) : -x + x = 0 :=
  x.induction_on
    (by rw [add_zero]; apply (Neg.aux R).map_zero)
    (fun x y => by convert (add_tmul (R := R) (-x) x y).symm; rw [add_left_neg, zero_tmul])
    fun x y hx hy => by
    suffices : -x + x + (-y + y) = 0
    · rw [← this]
      unfold Neg.neg neg
      simp only
      rw [AddMonoidHom.map_add]
      abel
    rw [hx, hy, add_zero]
#align tensor_product.add_left_neg TensorProduct.add_left_neg

instance addCommGroup : AddCommGroup (M ⊗[R] N) :=
  { TensorProduct.addCommMonoid with
    neg := Neg.neg
    sub := _
    sub_eq_add_neg := fun _ _ => rfl
    add_left_neg := fun x => TensorProduct.add_left_neg x
    zsmul := fun n v => n • v
    zsmul_zero' := by simp [TensorProduct.zero_smul]
    zsmul_succ' := by simp [Nat.succ_eq_one_add, TensorProduct.one_smul, TensorProduct.add_smul]
    zsmul_neg' := fun n x => by
      change (-n.succ : ℤ) • x = -(((n : ℤ) + 1) • x)
      rw [← zero_add (_ • x), ← TensorProduct.add_left_neg ((n.succ : ℤ) • x), add_assoc,
        ← add_smul, ← sub_eq_add_neg, sub_self, zero_smul, add_zero]
      rfl }

theorem neg_tmul (m : M) (n : N) : (-m) ⊗ₜ n = -m ⊗ₜ[R] n :=
  rfl
#align tensor_product.neg_tmul TensorProduct.neg_tmul

theorem tmul_neg (m : M) (n : N) : m ⊗ₜ (-n) = -m ⊗ₜ[R] n :=
  (mk R M N _).map_neg _
#align tensor_product.tmul_neg TensorProduct.tmul_neg

theorem tmul_sub (m : M) (n₁ n₂ : N) : m ⊗ₜ (n₁ - n₂) = m ⊗ₜ[R] n₁ - m ⊗ₜ[R] n₂ :=
  (mk R M N _).map_sub _ _
#align tensor_product.tmul_sub TensorProduct.tmul_sub

theorem sub_tmul (m₁ m₂ : M) (n : N) : (m₁ - m₂) ⊗ₜ n = m₁ ⊗ₜ[R] n - m₂ ⊗ₜ[R] n :=
  (mk R M N).map_sub₂ _ _ _
#align tensor_product.sub_tmul TensorProduct.sub_tmul

/-- While the tensor product will automatically inherit a ℤ-module structure from
`AddCommGroup.intModule`, that structure won't be compatible with lemmas like `tmul_smul` unless
we use a `ℤ-Module` instance provided by `TensorProduct.left_module`.

When `R` is a `Ring` we get the required `TensorProduct.compatible_smul` instance through
`IsScalarTower`, but when it is only a `Semiring` we need to build it from scratch.
The instance diamond in `compatible_smul` doesn't matter because it's in `Prop`.
-/
instance CompatibleSMul.int : CompatibleSMul R ℤ M N :=
  ⟨fun r m n =>
    Int.induction_on r (by simp) (fun r ih => by simpa [add_smul, tmul_add, add_tmul] using ih)
      fun r ih => by simpa [sub_smul, tmul_sub, sub_tmul] using ih⟩
#align tensor_product.compatible_smul.int TensorProduct.CompatibleSMul.int

instance CompatibleSMul.unit {S} [Monoid S] [DistribMulAction S M] [DistribMulAction S N]
    [CompatibleSMul R S M N] : CompatibleSMul R Sˣ M N :=
  ⟨fun s m n => (CompatibleSMul.smul_tmul (s : S) m n : _)⟩
#align tensor_product.compatible_smul.unit TensorProduct.CompatibleSMul.unit

end TensorProduct

namespace LinearMap

@[simp]
theorem ltensor_sub (f g : N →ₗ[R] P) : (f - g).ltensor M = f.ltensor M - g.ltensor M := by
  simp_rw [← coe_ltensorHom]
  exact (ltensorHom (R:=R) (N:=N) (P:=P) M).map_sub f g
#align linear_map.ltensor_sub LinearMap.ltensor_sub

@[simp]
theorem rtensor_sub (f g : N →ₗ[R] P) : (f - g).rtensor M = f.rtensor M - g.rtensor M := by
  simp only [← coe_rtensorHom]
  exact (rtensorHom (R:=R) (N:=N) (P:=P) M).map_sub f g
#align linear_map.rtensor_sub LinearMap.rtensor_sub

@[simp]
theorem ltensor_neg (f : N →ₗ[R] P) : (-f).ltensor M = -f.ltensor M := by
  simp only [← coe_ltensorHom]
  exact (ltensorHom (R:=R) (N:=N) (P:=P) M).map_neg f
#align linear_map.ltensor_neg LinearMap.ltensor_neg

@[simp]
theorem rtensor_neg (f : N →ₗ[R] P) : (-f).rtensor M = -f.rtensor M := by
  simp only [← coe_rtensorHom]
  exact (rtensorHom (R:=R) (N:=N) (P:=P) M).map_neg f
#align linear_map.rtensor_neg LinearMap.rtensor_neg

end LinearMap

end Ring