/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.congruence
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_4 u_3 u_2 u_5 l u_6 u_7 u_8 u_9

namespace Mathlib

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

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

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

Given any bilinear map `M → N → P`, there is a unique linear map `tensor_product R M N → P` whose
composition with the canonical bilinear map `M → N → tensor_product 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 `tensor_product R M N`, as well
as `m ⊗ₜ n` and `m ⊗ₜ[R] n` for `tensor_product.tmul R m n`.

## Tags

bilinear, tensor, tensor product
-/

namespace linear_map

/-- Create a bilinear map from a function that is linear in each component. -/
def mk₂ (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : M → N → P) (H1 : ∀ (m₁ m₂ : M) (n : N), f (m₁ + m₂) n = f m₁ n + f m₂ n) (H2 : ∀ (c : R) (m : M) (n : N), f (c • m) n = c • f m n) (H3 : ∀ (m : M) (n₁ n₂ : N), f m (n₁ + n₂) = f m n₁ + f m n₂) (H4 : ∀ (c : R) (m : M) (n : N), f m (c • n) = c • f m n) : linear_map R M (linear_map R N P) :=
  mk (fun (m : M) => mk (f m) (H3 m) sorry) sorry sorry

@[simp] theorem mk₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : M → N → P) {H1 : ∀ (m₁ m₂ : M) (n : N), f (m₁ + m₂) n = f m₁ n + f m₂ n} {H2 : ∀ (c : R) (m : M) (n : N), f (c • m) n = c • f m n} {H3 : ∀ (m : M) (n₁ n₂ : N), f m (n₁ + n₂) = f m n₁ + f m n₂} {H4 : ∀ (c : R) (m : M) (n : N), f m (c • n) = c • f m n} (m : M) (n : N) : coe_fn (coe_fn (mk₂ R f H1 H2 H3 H4) m) n = f m n :=
  rfl

theorem ext₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} {g : linear_map R M (linear_map R N P)} (H : ∀ (m : M) (n : N), coe_fn (coe_fn f m) n = coe_fn (coe_fn g m) n) : f = g :=
  ext fun (m : M) => ext fun (n : N) => H m n

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map from `M × N` to
`P`, change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def flip {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) : linear_map R N (linear_map R M P) :=
  mk₂ R (fun (n : N) (m : M) => coe_fn (coe_fn f m) n) sorry sorry sorry sorry

@[simp] theorem flip_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) : coe_fn (coe_fn (flip f) n) m = coe_fn (coe_fn f m) n :=
  rfl

theorem flip_inj {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} {g : linear_map R M (linear_map R N P)} (H : flip f = flip g) : f = g := sorry

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map `M → N → P`,
change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def lflip (R : Type u_1) [comm_semiring R] (M : Type u_2) (N : Type u_3) (P : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R M (linear_map R N P)) (linear_map R N (linear_map R M P)) :=
  mk flip sorry sorry

@[simp] theorem lflip_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) : coe_fn (coe_fn (coe_fn (lflip R M N P) f) n) m = coe_fn (coe_fn f m) n :=
  rfl

theorem map_zero₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (y : N) : coe_fn (coe_fn f 0) y = 0 :=
  map_zero (coe_fn (flip f) y)

theorem map_neg₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_monoid N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (x : M) (y : N) : coe_fn (coe_fn f (-x)) y = -coe_fn (coe_fn f x) y :=
  map_neg (coe_fn (flip f) y) x

theorem map_sub₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_monoid N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (x : M) (y : M) (z : N) : coe_fn (coe_fn f (x - y)) z = coe_fn (coe_fn f x) z - coe_fn (coe_fn f y) z :=
  map_sub (coe_fn (flip f) z) x y

theorem map_add₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (x₁ : M) (x₂ : M) (y : N) : coe_fn (coe_fn f (x₁ + x₂)) y = coe_fn (coe_fn f x₁) y + coe_fn (coe_fn f x₂) y :=
  map_add (coe_fn (flip f) y) x₁ x₂

theorem map_smul₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (r : R) (x : M) (y : N) : coe_fn (coe_fn f (r • x)) y = r • coe_fn (coe_fn f x) y :=
  map_smul (coe_fn (flip f) y) r x

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def lcomp (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} (P : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M N) : linear_map R (linear_map R N P) (linear_map R M P) :=
  flip (comp (flip id) f)

@[simp] theorem lcomp_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M N) (g : linear_map R N P) (x : M) : coe_fn (coe_fn (lcomp R P f) g) x = coe_fn g (coe_fn f x) :=
  rfl

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def llcomp (R : Type u_1) [comm_semiring R] (M : Type u_2) (N : Type u_3) (P : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R N P) (linear_map R (linear_map R M N) (linear_map R M P)) :=
  flip (mk (lcomp R P) sorry sorry)

@[simp] theorem llcomp_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R M N) (x : M) : coe_fn (coe_fn (coe_fn (llcomp R M N P) f) g) x = coe_fn f (coe_fn g x) :=
  rfl

/-- Composing a linear map `Q → N` and a bilinear map `M → N → P` to
form a bilinear map `M → Q → P`. -/
def compl₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M (linear_map R N P)) (g : linear_map R Q N) : linear_map R M (linear_map R Q P) :=
  comp (lcomp R P g) f

@[simp] theorem compl₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M (linear_map R N P)) (g : linear_map R Q N) (m : M) (q : Q) : coe_fn (coe_fn (compl₂ f g) m) q = coe_fn (coe_fn f m) (coe_fn g q) :=
  rfl

/-- Composing a linear map `P → Q` and a bilinear map `M × N → P` to
form a bilinear map `M → N → Q`. -/
def compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M (linear_map R N P)) (g : linear_map R P Q) : linear_map R M (linear_map R N Q) :=
  comp (coe_fn (llcomp R N P Q) g) f

@[simp] theorem compr₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M (linear_map R N P)) (g : linear_map R P Q) (m : M) (n : N) : coe_fn (coe_fn (compr₂ f g) m) n = coe_fn g (coe_fn (coe_fn f m) n) :=
  rfl

/-- Scalar multiplication as a bilinear map `R → M → M`. -/
def lsmul (R : Type u_1) [comm_semiring R] (M : Type u_2) [add_comm_monoid M] [semimodule R M] : linear_map R R (linear_map R M M) :=
  mk₂ R has_scalar.smul sorry sorry sorry sorry

@[simp] theorem lsmul_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] (r : R) (m : M) : coe_fn (coe_fn (lsmul R M) r) m = r • m :=
  rfl

end linear_map

namespace tensor_product

-- open free_add_monoid

/-- The relation on `free_add_monoid (M × N)` that generates a congruence whose quotient is
the tensor product. -/
inductive eqv (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : free_add_monoid (M × N) → free_add_monoid (M × N) → Prop
where
| of_zero_left : ∀ (n : N), eqv R M N (free_add_monoid.of (0, n)) 0
| of_zero_right : ∀ (m : M), eqv R M N (free_add_monoid.of (m, 0)) 0
| of_add_left : ∀ (m₁ m₂ : M) (n : N),
  eqv R M N (free_add_monoid.of (m₁, n) + free_add_monoid.of (m₂, n)) (free_add_monoid.of (m₁ + m₂, n))
| of_add_right : ∀ (m : M) (n₁ n₂ : N),
  eqv R M N (free_add_monoid.of (m, n₁) + free_add_monoid.of (m, n₂)) (free_add_monoid.of (m, n₁ + n₂))
| of_smul : ∀ (r : R) (m : M) (n : N), eqv R M N (free_add_monoid.of (r • m, n)) (free_add_monoid.of (m, r • n))
| add_comm : ∀ (x y : free_add_monoid (M × N)), eqv R M N (x + y) (y + x)

end tensor_product

/-- The tensor product of two semimodules `M` and `N` over the same commutative semiring `R`.
The localized notations are `M ⊗ N` and `M ⊗[R] N`, accessed by `open_locale tensor_product`. -/
def tensor_product (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :=
  add_con.quotient (add_con_gen sorry)

namespace tensor_product

protected instance add_comm_monoid {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : add_comm_monoid (tensor_product R M N) :=
  add_comm_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry sorry

protected instance inhabited {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : Inhabited (tensor_product R M N) :=
  { default := 0 }

/-- The canonical function `M → N → M ⊗ N`. The localized notations are `m ⊗ₜ n` and `m ⊗ₜ[R] n`,
accessed by `open_locale tensor_product`. -/
def tmul (R : Type u_1) [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) : tensor_product R M N :=
  coe_fn (add_con.mk' (add_con_gen (eqv R M N))) (free_add_monoid.of (m, n))

protected theorem induction_on {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] {C : tensor_product R M N → Prop} (z : tensor_product R M N) (C0 : C 0) (C1 : ∀ {x : M} {y : N}, C (tmul R x y)) (Cp : ∀ {x y : tensor_product R M N}, C x → C y → C (x + y)) : C z := sorry

@[simp] theorem zero_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (n : N) : tmul R 0 n = 0 :=
  quotient.sound' (add_con_gen.rel.of (free_add_monoid.of (0, n)) 0 (eqv.of_zero_left n))

theorem add_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m₁ : M) (m₂ : M) (n : N) : tmul R (m₁ + m₂) n = tmul R m₁ n + tmul R m₂ n := sorry

@[simp] theorem tmul_zero {R : Type u_1} [comm_semiring R] {M : Type u_3} (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) : tmul R m 0 = 0 :=
  quotient.sound' (add_con_gen.rel.of (free_add_monoid.of (m, 0)) 0 (eqv.of_zero_right m))

theorem tmul_add {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n₁ : N) (n₂ : N) : tmul R m (n₁ + n₂) = tmul R m n₁ + tmul R m n₂ := sorry

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

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

Note that `semimodule R' (M ⊗[R] N)` is available even without this typeclass on `R'`; it's only
needed if `tensor_product.smul_tmul`, `tensor_product.smul_tmul'`, or `tensor_product.tmul_smul` is
used.
-/
class compatible_smul (R : Type u_1) [comm_semiring R] (R' : Type u_2) [comm_semiring R'] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N]
where
  smul_tmul : ∀ (r : R') (m : M) (n : N), tmul R (r • m) n = tmul R m (r • n)

/-- Note that this provides the default `compatible_smul R R M N` instance through
`mul_action.is_scalar_tower.left`. -/
protected instance compatible_smul.is_scalar_tower {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [has_scalar R' R] [is_scalar_tower R' R M] [is_scalar_tower R' R N] : compatible_smul R R' M N :=
  compatible_smul.mk sorry

/-- `smul` can be moved from one side of the product to the other .-/
theorem smul_tmul {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [compatible_smul R R' M N] (r : R') (m : M) (n : N) : tmul R (r • m) n = tmul R m (r • n) :=
  compatible_smul.smul_tmul r m n

/-- Auxiliary function to defining scalar multiplication on tensor product. -/
def smul.aux {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] {R' : Type u_2} [has_scalar R' M] (r : R') : free_add_monoid (M × N) →+ tensor_product R M N :=
  coe_fn free_add_monoid.lift fun (p : M × N) => tmul R (r • prod.fst p) (prod.snd p)

theorem smul.aux_of {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] {R' : Type u_2} [has_scalar R' M] (r : R') (m : M) (n : N) : coe_fn (smul.aux r) (free_add_monoid.of (m, n)) = tmul R (r • m) n :=
  rfl

-- Most of the time we want the instance below this one, which is easier for typeclass resolution

-- to find. The `unused_arguments` is from one of the two comm_classes - while we only make use

-- of one, it makes sense to make the API symmetric.

protected instance has_scalar' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] : has_scalar R' (tensor_product R M N) :=
  has_scalar.mk fun (r : R') => ⇑(add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) sorry)

protected instance has_scalar {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : has_scalar R (tensor_product R M N) :=
  tensor_product.has_scalar'

protected theorem smul_zero {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] (r : R') : r • 0 = 0 :=
  add_monoid_hom.map_zero (add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) (has_scalar'._proof_1 r))

protected theorem smul_add {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] (r : R') (x : tensor_product R M N) (y : tensor_product R M N) : r • (x + y) = r • x + r • y :=
  add_monoid_hom.map_add (add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) (has_scalar'._proof_1 r)) x y

-- Most of the time we want the instance below this one, which is easier for typeclass resolution

-- to find.

protected instance semimodule' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] : semimodule R' (tensor_product R M N) :=
  (fun (this : ∀ (r : R') (m : M) (n : N), r • tmul R m n = tmul R (r • m) n) => semimodule.mk sorry sorry) sorry

protected instance semimodule {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : semimodule R (tensor_product R M N) :=
  tensor_product.semimodule'

-- note that we don't actually need `compatible_smul` here, but we include it for symmetry

-- with `tmul_smul` to avoid exposing our asymmetric definition.

theorem smul_tmul' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] [compatible_smul R R' M N] (r : R') (m : M) (n : N) : r • tmul R m n = tmul R (r • m) n :=
  rfl

@[simp] theorem tmul_smul {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M] [smul_comm_class R R' N] [compatible_smul R R' M N] (r : R') (x : M) (y : N) : tmul R x (r • y) = r • tmul R x y :=
  Eq.symm (smul_tmul r x y)

/-- The canonical bilinear map `M → N → M ⊗[R] N`. -/
def mk (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : linear_map R M (linear_map R N (tensor_product R M N)) :=
  linear_map.mk₂ R (fun (_x : M) (_y : N) => tmul R _x _y) add_tmul sorry tmul_add sorry

@[simp] theorem mk_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) : coe_fn (coe_fn (mk R M N) m) n = tmul R m n :=
  rfl

theorem ite_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (x₁ : M) (x₂ : N) (P : Prop) [Decidable P] : tmul R (ite P x₁ 0) x₂ = ite P (tmul R x₁ x₂) 0 := sorry

theorem tmul_ite {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (x₁ : M) (x₂ : N) (P : Prop) [Decidable P] : tmul R x₁ (ite P x₂ 0) = ite P (tmul R x₁ x₂) 0 := sorry

theorem sum_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] {α : Type u_2} (s : finset α) (m : α → M) (n : N) : tmul R (finset.sum s fun (a : α) => m a) n = finset.sum s fun (a : α) => tmul R (m a) n := sorry

theorem tmul_sum {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) {α : Type u_2} (s : finset α) (n : α → N) : tmul R m (finset.sum s fun (a : α) => n a) = finset.sum s fun (a : α) => tmul R m (n a) := sorry

/-- 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 lift_aux {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) : tensor_product R M N →+ P :=
  add_con.lift (add_con_gen (eqv R M N))
    (coe_fn free_add_monoid.lift fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p)) sorry

theorem lift_aux_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) : coe_fn (lift_aux f) (tmul R m n) = coe_fn (coe_fn f m) n :=
  zero_add ((fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p)) (m, n))

@[simp] theorem lift_aux.smul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (r : R) (x : tensor_product R M N) : coe_fn (lift_aux f) (r • x) = r • coe_fn (lift_aux f) x := sorry

/-- 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 {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) : linear_map R (tensor_product R M N) P :=
  linear_map.mk (add_monoid_hom.to_fun (lift_aux f)) sorry lift_aux.smul

@[simp] theorem lift.tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (x : M) (y : N) : coe_fn (lift f) (tmul R x y) = coe_fn (coe_fn f x) y :=
  zero_add ((fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p)) (x, y))

@[simp] theorem lift.tmul' {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (x : M) (y : N) : linear_map.to_fun (lift f) (tmul R x y) = coe_fn (coe_fn f x) y :=
  lift.tmul x y

theorem ext {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {g : linear_map R (tensor_product R M N) P} {h : linear_map R (tensor_product R M N) P} (H : ∀ (x : M) (y : N), coe_fn g (tmul R x y) = coe_fn h (tmul R x y)) : g = h := sorry

theorem lift.unique {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} {g : linear_map R (tensor_product R M N) P} (H : ∀ (x : M) (y : N), coe_fn g (tmul R x y) = coe_fn (coe_fn f x) y) : g = lift f := sorry

theorem lift_mk {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : lift (mk R M N) = linear_map.id :=
  Eq.symm (lift.unique fun (x : M) (y : N) => rfl)

theorem lift_compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {f : linear_map R M (linear_map R N P)} (g : linear_map R P Q) : lift (linear_map.compr₂ f g) = linear_map.comp g (lift f) := sorry

theorem lift_mk_compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) : lift (linear_map.compr₂ (mk R M N) f) = f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) f) = f)) (lift_compr₂ f)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (linear_map.comp f (lift (mk R M N)) = f)) lift_mk))
      (eq.mpr (id (Eq._oldrec (Eq.refl (linear_map.comp f linear_map.id = f)) (linear_map.comp_id f))) (Eq.refl f)))

theorem mk_compr₂_inj {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] {g : linear_map R (tensor_product R M N) P} {h : linear_map R (tensor_product R M N) P} (H : linear_map.compr₂ (mk R M N) g = linear_map.compr₂ (mk R M N) h) : g = h :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g = h)) (Eq.symm (lift_mk_compr₂ g))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) g) = h)) H))
      (eq.mpr (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) h) = h)) (lift_mk_compr₂ h))) (Eq.refl h)))

/-- 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 (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R M (linear_map R N P)) (linear_map R (tensor_product R M N) P) :=
  linear_map.flip
    (lift (linear_map.comp (linear_map.lflip R (linear_map R M (linear_map R N P)) N P) (linear_map.flip linear_map.id)))

@[simp] theorem uncurry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) : coe_fn (coe_fn (uncurry R M N P) f) (tmul R m n) = coe_fn (coe_fn f m) n := sorry

/-- 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 (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_equiv R (linear_map R M (linear_map R N P)) (linear_map R (tensor_product R M N) P) :=
  linear_equiv.mk (linear_map.to_fun (uncurry R M N P)) sorry sorry
    (fun (f : linear_map R (tensor_product R M N) P) => linear_map.compr₂ (mk R M N) f) sorry sorry

/-- 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 (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R (tensor_product R M N) P) (linear_map R M (linear_map R N P)) :=
  ↑(linear_equiv.symm (lift.equiv R M N P))

@[simp] theorem lcurry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) (m : M) (n : N) : coe_fn (coe_fn (coe_fn (lcurry R M N P) f) m) n = coe_fn f (tmul R m n) :=
  rfl

/-- 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 {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) : linear_map R M (linear_map R N P) :=
  coe_fn (lcurry R M N P) f

@[simp] theorem curry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) (m : M) (n : N) : coe_fn (coe_fn (curry f) m) n = coe_fn f (tmul R m n) :=
  rfl

theorem ext_threefold {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {g : linear_map R (tensor_product R (tensor_product R M N) P) Q} {h : linear_map R (tensor_product R (tensor_product R M N) P) Q} (H : ∀ (x : M) (y : N) (z : P), coe_fn g (tmul R (tmul R x y) z) = coe_fn h (tmul R (tmul R x y) z)) : g = h := sorry

-- We'll need this one for checking the pentagon identity!

theorem ext_fourfold {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] [semimodule R S] {g : linear_map R (tensor_product R (tensor_product R (tensor_product R M N) P) Q) S} {h : linear_map R (tensor_product R (tensor_product R (tensor_product R M N) P) Q) S} (H : ∀ (w : M) (x : N) (y : P) (z : Q),
  coe_fn g (tmul R (tmul R (tmul R w x) y) z) = coe_fn h (tmul R (tmul R (tmul R w x) y) z)) : g = h := sorry

/--
The base ring is a left identity for the tensor product of modules, up to linear equivalence.
-/
protected def lid (R : Type u_1) [comm_semiring R] (M : Type u_3) [add_comm_monoid M] [semimodule R M] : linear_equiv R (tensor_product R R M) M :=
  linear_equiv.of_linear (lift (linear_map.lsmul R M)) (coe_fn (mk R R M) 1) sorry sorry

@[simp] theorem lid_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M] [semimodule R M] (m : M) (r : R) : coe_fn (tensor_product.lid R M) (tmul R r m) = r • m := sorry

@[simp] theorem lid_symm_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M] [semimodule R M] (m : M) : coe_fn (linear_equiv.symm (tensor_product.lid R M)) m = tmul R 1 m :=
  rfl

/--
The tensor product of modules is commutative, up to linear equivalence.
-/
protected def comm (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : linear_equiv R (tensor_product R M N) (tensor_product R N M) :=
  linear_equiv.of_linear (lift (linear_map.flip (mk R N M))) (lift (linear_map.flip (mk R M N))) sorry sorry

@[simp] theorem comm_tmul (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) : coe_fn (tensor_product.comm R M N) (tmul R m n) = tmul R n m :=
  rfl

@[simp] theorem comm_symm_tmul (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) : coe_fn (linear_equiv.symm (tensor_product.comm R M N)) (tmul R n m) = tmul R m n :=
  rfl

/--
The base ring is a right identity for the tensor product of modules, up to linear equivalence.
-/
protected def rid (R : Type u_1) [comm_semiring R] (M : Type u_3) [add_comm_monoid M] [semimodule R M] : linear_equiv R (tensor_product R M R) M :=
  linear_equiv.trans (tensor_product.comm R M R) (tensor_product.lid R M)

@[simp] theorem rid_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M] [semimodule R M] (m : M) (r : R) : coe_fn (tensor_product.rid R M) (tmul R m r) = r • m := sorry

@[simp] theorem rid_symm_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M] [semimodule R M] (m : M) : coe_fn (linear_equiv.symm (tensor_product.rid R M)) m = tmul R m 1 :=
  rfl

/-- The associator for tensor product of R-modules, as a linear equivalence. -/
protected def assoc (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5) [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_equiv R (tensor_product R (tensor_product R M N) P) (tensor_product R M (tensor_product R N P)) :=
  linear_equiv.of_linear
    (lift
      (lift (linear_map.comp (lcurry R N P (tensor_product R M (tensor_product R N P))) (mk R M (tensor_product R N P)))))
    (lift
      (linear_map.comp (uncurry R N P (tensor_product R (tensor_product R M N) P))
        (curry (mk R (tensor_product R M N) P))))
    sorry sorry

@[simp] theorem assoc_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (m : M) (n : N) (p : P) : coe_fn (tensor_product.assoc R M N P) (tmul R (tmul R m n) p) = tmul R m (tmul R n p) :=
  rfl

@[simp] theorem assoc_symm_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (m : M) (n : N) (p : P) : coe_fn (linear_equiv.symm (tensor_product.assoc R M N P)) (tmul R m (tmul R n p)) = tmul R (tmul R m n) p :=
  rfl

/-- The tensor product of a pair of linear maps between modules. -/
def map {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M P) (g : linear_map R N Q) : linear_map R (tensor_product R M N) (tensor_product R P Q) :=
  lift (linear_map.comp (linear_map.compl₂ (mk R P Q) g) f)

@[simp] theorem map_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M P) (g : linear_map R N Q) (m : M) (n : N) : coe_fn (map f g) (tmul R m n) = tmul R (coe_fn f m) (coe_fn g n) :=
  rfl

theorem map_comp {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {P' : Type u_8} {Q' : Type u_9} [add_comm_monoid P'] [semimodule R P'] [add_comm_monoid Q'] [semimodule R Q'] (f₂ : linear_map R P P') (f₁ : linear_map R M P) (g₂ : linear_map R Q Q') (g₁ : linear_map R N Q) : map (linear_map.comp f₂ f₁) (linear_map.comp g₂ g₁) = linear_map.comp (map f₂ g₂) (map f₁ g₁) := sorry

theorem lift_comp_map {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {Q' : Type u_9} [add_comm_monoid Q'] [semimodule R Q'] (i : linear_map R P (linear_map R Q Q')) (f : linear_map R M P) (g : linear_map R N Q) : linear_map.comp (lift i) (map f g) = lift (linear_map.compl₂ (linear_map.comp i f) g) := sorry

/-- 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 {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_equiv R M P) (g : linear_equiv R N Q) : linear_equiv R (tensor_product R M N) (tensor_product R P Q) :=
  linear_equiv.of_linear (map ↑f ↑g) (map ↑(linear_equiv.symm f) ↑(linear_equiv.symm g)) sorry sorry

@[simp] theorem congr_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_equiv R M P) (g : linear_equiv R N Q) (m : M) (n : N) : coe_fn (congr f g) (tmul R m n) = tmul R (coe_fn f m) (coe_fn g n) :=
  rfl

@[simp] theorem congr_symm_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_equiv R M P) (g : linear_equiv R N Q) (p : P) (q : Q) : coe_fn (linear_equiv.symm (congr f g)) (tmul R p q) =
  tmul R (coe_fn (linear_equiv.symm f) p) (coe_fn (linear_equiv.symm g) q) :=
  rfl

end tensor_product

namespace linear_map

/-- `ltensor M f : M ⊗ N →ₗ M ⊗ P` is the natural linear map induced by `f : N →ₗ P`. -/
def ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) : linear_map R (tensor_product R M N) (tensor_product R M P) :=
  tensor_product.map id f

/-- `rtensor f M : N₁ ⊗ M →ₗ N₂ ⊗ M` is the natural linear map induced by `f : N₁ →ₗ N₂`. -/
def rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) : linear_map R (tensor_product R N M) (tensor_product R P M) :=
  tensor_product.map f id

@[simp] theorem ltensor_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (m : M) (n : N) : coe_fn (ltensor M f) (tensor_product.tmul R m n) = tensor_product.tmul R m (coe_fn f n) :=
  rfl

@[simp] theorem rtensor_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (m : M) (n : N) : coe_fn (rtensor M f) (tensor_product.tmul R n m) = tensor_product.tmul R (coe_fn f n) m :=
  rfl

/-- `ltensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def ltensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R N P) (linear_map R (tensor_product R M N) (tensor_product R M P)) :=
  mk (ltensor M) sorry sorry

/-- `rtensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def rtensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : linear_map R (linear_map R N P) (linear_map R (tensor_product R N M) (tensor_product R P M)) :=
  mk (fun (f : linear_map R N P) => rtensor M f) sorry sorry

@[simp] theorem coe_ltensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : ⇑(ltensor_hom M) = ltensor M :=
  rfl

@[simp] theorem coe_rtensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : ⇑(rtensor_hom M) = rtensor M :=
  rfl

@[simp] theorem ltensor_add {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) : ltensor M (f + g) = ltensor M f + ltensor M g :=
  map_add (ltensor_hom M) f g

@[simp] theorem rtensor_add {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) : rtensor M (f + g) = rtensor M f + rtensor M g :=
  map_add (rtensor_hom M) f g

@[simp] theorem ltensor_zero {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : ltensor M 0 = 0 :=
  map_zero (ltensor_hom M)

@[simp] theorem rtensor_zero {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] : rtensor M 0 = 0 :=
  map_zero (rtensor_hom M)

@[simp] theorem ltensor_smul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (r : R) (f : linear_map R N P) : ltensor M (r • f) = r • ltensor M f :=
  map_smul (ltensor_hom M) r f

@[simp] theorem rtensor_smul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N] [semimodule R P] (r : R) (f : linear_map R N P) : rtensor M (r • f) = r • rtensor M f :=
  map_smul (rtensor_hom M) r f

theorem ltensor_comp {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (g : linear_map R P Q) (f : linear_map R N P) : ltensor M (comp g f) = comp (ltensor M g) (ltensor M f) := sorry

theorem rtensor_comp {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (g : linear_map R P Q) (f : linear_map R N P) : rtensor M (comp g f) = comp (rtensor M g) (rtensor M f) := sorry

@[simp] theorem ltensor_id {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : ltensor M id = id := sorry

@[simp] theorem rtensor_id {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : rtensor M id = id := sorry

@[simp] theorem ltensor_comp_rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M P) (g : linear_map R N Q) : comp (ltensor P g) (rtensor N f) = tensor_product.map f g := sorry

@[simp] theorem rtensor_comp_ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M P) (g : linear_map R N Q) : comp (rtensor Q f) (ltensor M g) = tensor_product.map f g := sorry

@[simp] theorem map_comp_rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] [semimodule R S] (f : linear_map R M P) (g : linear_map R N Q) (f' : linear_map R S M) : comp (tensor_product.map f g) (rtensor N f') = tensor_product.map (comp f f') g := sorry

@[simp] theorem map_comp_ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] [semimodule R S] (f : linear_map R M P) (g : linear_map R N Q) (g' : linear_map R S N) : comp (tensor_product.map f g) (ltensor M g') = tensor_product.map f (comp g g') := sorry

@[simp] theorem rtensor_comp_map {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] [semimodule R S] (f' : linear_map R P S) (f : linear_map R M P) (g : linear_map R N Q) : comp (rtensor Q f') (tensor_product.map f g) = tensor_product.map (comp f' f) g := sorry

@[simp] theorem ltensor_comp_map {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] [semimodule R S] (g' : linear_map R Q S) (f : linear_map R M P) (g : linear_map R N Q) : comp (ltensor P g') (tensor_product.map f g) = tensor_product.map f (comp g' g) := sorry

end linear_map

namespace tensor_product

/-- Auxiliary function to defining negation multiplication on tensor product. -/
def neg.aux (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] : free_add_monoid (M × N) →+ tensor_product R M N :=
  coe_fn free_add_monoid.lift fun (p : M × N) => tmul R (-prod.fst p) (prod.snd p)

theorem neg.aux_of {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) : coe_fn (neg.aux R) (free_add_monoid.of (m, n)) = tmul R (-m) n :=
  rfl

protected instance has_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] : Neg (tensor_product R M N) :=
  { neg := ⇑(add_con.lift (add_con_gen (eqv R M N)) (neg.aux R) sorry) }

protected instance add_comm_group {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] : add_comm_group (tensor_product R M N) :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg
    (fun (_x _x_1 : tensor_product R M N) => add_semigroup.add _x (-_x_1)) sorry sorry

theorem neg_tmul {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) : tmul R (-m) n = -tmul R m n :=
  rfl

theorem tmul_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) : tmul R m (-n) = -tmul R m n :=
  linear_map.map_neg (coe_fn (mk R M N) m) n

theorem tmul_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n₁ : N) (n₂ : N) : tmul R m (n₁ - n₂) = tmul R m n₁ - tmul R m n₂ :=
  linear_map.map_sub (coe_fn (mk R M N) m) n₁ n₂

theorem sub_tmul {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] (m₁ : M) (m₂ : M) (n : N) : tmul R (m₁ - m₂) n = tmul R m₁ n - tmul R m₂ n :=
  linear_map.map_sub₂ (mk R M N) m₁ m₂ n

/--
While the tensor product will automatically inherit a ℤ-module structure from
`add_comm_group.int_module`, that structure won't be compatible with lemmas like `tmul_smul` unless
we use a `ℤ-module` instance provided by `tensor_product.semimodule'`.

When `R` is a `ring` we get the required `tensor_product.compatible_smul` instance through
`is_scalar_tower`, 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`.
-/
protected instance compatible_smul.int {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] [semimodule ℤ M] [semimodule ℤ N] : compatible_smul R ℤ M N :=
  compatible_smul.mk sorry

end tensor_product

namespace linear_map

@[simp] theorem ltensor_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) : ltensor M (f - g) = ltensor M f - ltensor M g := sorry

@[simp] theorem rtensor_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) : rtensor M (f - g) = rtensor M f - rtensor M g := sorry

@[simp] theorem ltensor_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) : ltensor M (-f) = -ltensor M f := sorry

@[simp] theorem rtensor_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M] [semimodule R N] [semimodule R P] (f : linear_map R N P) : rtensor M (-f) = -rtensor M f := sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.braided
import Mathlib.category_theory.monoidal.Mon_
import Mathlib.PostPort

universes v₁ u₁ l u₂ v₂ u_1 u_2

namespace Mathlib

/-!
# The category of commutative monoids in a braided monoidal category.
-/

/--
A commutative monoid object internal to a monoidal category.
-/
structure CommMon_ (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C]
    [category_theory.braided_category C]
    extends Mon_ C where
  mul_comm' :
    autoParam (category_theory.iso.hom β_ ≫ Mon_.mul _to_Mon_ = Mon_.mul _to_Mon_)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem CommMon_.mul_comm {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (c : CommMon_ C) :
    category_theory.iso.hom β_ ≫ Mon_.mul (CommMon_.to_Mon_ c) = Mon_.mul (CommMon_.to_Mon_ c) :=
  sorry

@[simp] theorem CommMon_.mul_comm_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (c : CommMon_ C)
    {X' : C} (f' : Mon_.X (CommMon_.to_Mon_ c) ⟶ X') :
    category_theory.iso.hom β_ ≫ Mon_.mul (CommMon_.to_Mon_ c) ≫ f' =
        Mon_.mul (CommMon_.to_Mon_ c) ≫ f' :=
  sorry

namespace CommMon_

/--
The trivial commutative monoid object. We later show this is initial in `CommMon_ C`.
-/
def trivial (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C]
    [category_theory.braided_category C] : CommMon_ C :=
  mk (Mon_.mk (Mon_.X (Mon_.trivial C)) (Mon_.one (Mon_.trivial C)) (Mon_.mul (Mon_.trivial C)))

protected instance inhabited (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] :
    Inhabited (CommMon_ C) :=
  { default := trivial C }

protected instance category_theory.category {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] :
    category_theory.category (CommMon_ C) :=
  category_theory.induced_category.category to_Mon_

@[simp] theorem id_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (A : CommMon_ C) :
    Mon_.hom.hom 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] {R : CommMon_ C}
    {S : CommMon_ C} {T : CommMon_ C} (f : R ⟶ S) (g : S ⟶ T) :
    Mon_.hom.hom (f ≫ g) = Mon_.hom.hom f ≫ Mon_.hom.hom g :=
  rfl

/-- The forgetful functor from commutative monoid objects to monoid objects. -/
def forget₂_Mon_ (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C]
    [category_theory.braided_category C] : CommMon_ C ⥤ Mon_ C :=
  category_theory.induced_functor to_Mon_

@[simp] theorem forget₂_Mon_obj_one (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (A : CommMon_ C) :
    Mon_.one (category_theory.functor.obj (forget₂_Mon_ C) A) = Mon_.one (to_Mon_ A) :=
  rfl

@[simp] theorem forget₂_Mon_obj_mul (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (A : CommMon_ C) :
    Mon_.mul (category_theory.functor.obj (forget₂_Mon_ C) A) = Mon_.mul (to_Mon_ A) :=
  rfl

@[simp] theorem forget₂_Mon_map_hom (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] {A : CommMon_ C}
    {B : CommMon_ C} (f : A ⟶ B) :
    Mon_.hom.hom (category_theory.functor.map (forget₂_Mon_ C) f) = Mon_.hom.hom f :=
  rfl

protected instance unique_hom_from_trivial {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (A : CommMon_ C) :
    unique (trivial C ⟶ A) :=
  Mon_.unique_hom_from_trivial (to_Mon_ A)

protected instance category_theory.limits.has_initial {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] :
    category_theory.limits.has_initial (CommMon_ C) :=
  category_theory.limits.has_initial_of_unique (trivial C)

end CommMon_

namespace category_theory.lax_braided_functor

/--
A lax braided functor takes commutative monoid objects to commutative monoid objects.

That is, a lax braided functor `F : C ⥤ D` induces a functor `CommMon_ C ⥤ CommMon_ D`.
-/
@[simp] theorem map_CommMon_map {C : Type u₁} [category C] [monoidal_category C]
    [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D]
    (F : lax_braided_functor C D) (A : CommMon_ C) (B : CommMon_ C) (f : A ⟶ B) :
    functor.map (map_CommMon F) f =
        functor.map (lax_monoidal_functor.map_Mon (to_lax_monoidal_functor F)) f :=
  Eq.refl (functor.map (map_CommMon F) f)

/-- `map_CommMon` is functorial in the lax braided functor. -/
def map_CommMon_functor (C : Type u₁) [category C] [monoidal_category C] [braided_category C]
    (D : Type u₂) [category D] [monoidal_category D] [braided_category D] :
    lax_braided_functor C D ⥤ CommMon_ C ⥤ CommMon_ D :=
  functor.mk map_CommMon
    fun (F G : lax_braided_functor C D) (α : F ⟶ G) =>
      nat_trans.mk
        fun (A : CommMon_ C) =>
          Mon_.hom.mk
            (nat_trans.app (monoidal_nat_trans.to_nat_trans α) (Mon_.X (CommMon_.to_Mon_ A)))

end category_theory.lax_braided_functor

namespace CommMon_

namespace equiv_lax_braided_functor_punit

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simp] theorem lax_braided_to_CommMon_map (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C]
    (F : category_theory.lax_braided_functor (category_theory.discrete PUnit) C)
    (G : category_theory.lax_braided_functor (category_theory.discrete PUnit) C) (α : F ⟶ G) :
    category_theory.functor.map (lax_braided_to_CommMon C) α =
        category_theory.nat_trans.app
          (category_theory.functor.map
            (category_theory.lax_braided_functor.map_CommMon_functor
              (category_theory.discrete PUnit) C)
            α)
          (trivial (category_theory.discrete PUnit)) :=
  Eq.refl (category_theory.functor.map (lax_braided_to_CommMon C) α)

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simp] theorem CommMon_to_lax_braided_obj_to_lax_monoidal_functor_to_functor_obj (C : Type u₁)
    [category_theory.category C] [category_theory.monoidal_category C]
    [category_theory.braided_category C] (A : CommMon_ C) (_x : category_theory.discrete PUnit) :
    category_theory.functor.obj
          (category_theory.lax_monoidal_functor.to_functor
            (category_theory.lax_braided_functor.to_lax_monoidal_functor
              (category_theory.functor.obj (CommMon_to_lax_braided C) A)))
          _x =
        Mon_.X (to_Mon_ A) :=
  sorry

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simp] theorem unit_iso_hom_app_to_nat_trans_app (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C]
    (X : category_theory.lax_braided_functor (category_theory.discrete PUnit) C) :
    ∀ (X_1 : category_theory.discrete PUnit),
        category_theory.nat_trans.app
            (category_theory.monoidal_nat_trans.to_nat_trans
              (category_theory.nat_trans.app (category_theory.iso.hom (unit_iso C)) X))
            X_1 =
          category_theory.eq_to_hom
            (congr_arg
              (category_theory.functor.obj
                (category_theory.lax_monoidal_functor.to_functor
                  (category_theory.lax_braided_functor.to_lax_monoidal_functor X)))
              (unit_iso._proof_1 X_1)) :=
  sorry

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simp] theorem counit_iso_inv_app_hom (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] (X : CommMon_ C) :
    Mon_.hom.hom (category_theory.nat_trans.app (category_theory.iso.inv (counit_iso C)) X) = 𝟙 :=
  Eq.refl 𝟙

end equiv_lax_braided_functor_punit

/--
Commutative monoid objects in `C` are "just" braided lax monoidal functors from the trivial
braided monoidal category to `C`.
-/
@[simp] theorem equiv_lax_braided_functor_punit_functor (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] [category_theory.braided_category C] :
    category_theory.equivalence.functor (equiv_lax_braided_functor_punit C) =
        equiv_lax_braided_functor_punit.lax_braided_to_CommMon C :=
  Eq.refl (category_theory.equivalence.functor (equiv_lax_braided_functor_punit C))

end Mathlib


import for_mathlib.derived.K_projective
import for_mathlib.homological_complex_op
import for_mathlib.homology_iso_Ab

noncomputable theory

universes v u

open category_theory category_theory.limits category_theory.preadditive

variables {C : Type u} {ι : Type*} [category.{v} C] [abelian C] {c : complex_shape ι}

def homotopy_category.quotient_map_hom (A B : homological_complex C c) :
  (A ⟶ B) →+ ((homotopy_category.quotient C c).obj A ⟶ (homotopy_category.quotient C c).obj B) :=
add_monoid_hom.mk' (λ f, (homotopy_category.quotient C c).map f) $ λ f g, rfl

lemma quot.mk_surjective {X : Type*} (r : X → X → Prop) :
  function.surjective (quot.mk r) :=
λ x, quot.induction_on x $ λ x, ⟨x, rfl⟩

noncomputable
def homotopy.to_single [decidable_eq ι] [decidable_rel c.rel] {X : homological_complex C c} {B : C}
  {i j : ι} (r : c.rel i j)
  (f g : X ⟶ (homological_complex.single C c i).obj B) (h : X.X j ⟶ B)
  (H : f.f i = X.d i j ≫ h ≫ eq_to_hom (if_pos rfl).symm + g.f i) :
  homotopy f g :=
{ hom := λ i₁ i₂, if r' : c.rel i₂ i₁ then if e : i₂ = i then
    (X.X_eq_to_iso (c.next_eq (e ▸ r' : c.rel i i₁) r)).hom ≫ h ≫ eq_to_hom (if_pos e).symm
    else 0 else 0,
  zero' := λ _ _ e, dif_neg e,
  comm := λ k, begin
    dsimp,
    by_cases k = i,
    swap, { apply is_zero.eq_of_tgt, dsimp, rw if_neg h, exact is_zero_zero _ },
    subst h,
    rw [d_next_eq _ r, dif_pos r, dif_pos rfl, H, X.X_eq_to_iso_refl, category.id_comp],
    nth_rewrite_lhs 0 ← add_monoid.add_zero (X.d k j ≫ h ≫ eq_to_hom _),
    congr,
    delta prev_d,
    rcases c.prev k with (_|⟨i, _⟩); dsimp,
    { refl },
    { rw comp_zero, refl }
  end }

lemma homotopic_to_single_iff [decidable_eq ι] {X : homological_complex C c}
  {B : C} {i j : ι} (r : c.rel i j)
  (f g : X ⟶ (homological_complex.single C c i).obj B) :
  homotopic _ _ f g ↔
    ∃ (h : X.X j ⟶ B), f.f i = X.d i j ≫ h ≫ eq_to_hom (if_pos rfl).symm + g.f i :=
begin
  haveI : decidable_rel c.rel := λ _ _, classical.dec _,
  refine ⟨_, λ ⟨h, H⟩, ⟨homotopy.to_single r f g h H⟩⟩,
  rintro ⟨h⟩,
  use h.hom j i ≫ eq_to_hom (if_pos rfl),
  rw [category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id, ← add_zero (_ ≫ _)],
  have := h.comm i,
  rw [d_next_eq _ r] at this,
  convert this,
  delta prev_d,
  rcases c.prev i with (_|⟨j, _⟩); dsimp; simp
end

instance : decidable_rel (complex_shape.up ℤ).rel :=
λ i j, show decidable (i + 1 = j), by apply_instance

@[simps] noncomputable
def homological_complex.hom_single_iso
  (P : cochain_complex C ℤ) (B : C) (i : ℤ) :
  (P ⟶ (homological_complex.single C (complex_shape.up ℤ) i).obj B) ≃+
    (add_monoid_hom.ker ((((preadditive_yoneda.obj B).map_homological_complex
      (complex_shape.up ℤ).symm).obj P.op).d i (i - 1))) :=
{ to_fun := λ f, begin
    refine ⟨f.f i ≫ eq_to_hom (if_pos rfl), _⟩,
    change P.d (i - 1) i ≫ f.f i ≫ eq_to_hom _ = 0,
    rw ← f.comm_assoc,
    dsimp,
    rw [zero_comp, comp_zero],
  end,
  inv_fun := λ f, begin
    refine ⟨λ j, if e : j = i then
      (P.X_eq_to_iso $ e).hom ≫ f.1 ≫ eq_to_hom (if_pos e).symm else 0, _⟩,
    rintros j k (rfl : j + 1 = k),
    dsimp,
    rw comp_zero,
    split_ifs,
    { have := eq_sub_iff_add_eq.mpr h, subst this,
      rw [P.X_d_eq_to_iso_assoc, ← category.assoc, ← subtype.val_eq_coe,
        show P.d (i - 1) i ≫ f.1 = 0, from f.2, zero_comp] },
    { exact comp_zero.symm }
  end,
  left_inv := begin
    intro f,
    ext j,
    dsimp,
    split_ifs,
    { subst h, simp },
    { apply is_zero.eq_of_tgt, rw if_neg h, exact is_zero_zero _ }
  end,
  right_inv := λ f, by { ext, dsimp, simp },
  map_add' := λ f g, subtype.ext (preadditive.add_comp _ _ _ _ _ _) }

namespace bounded_homotopy_category

namespace hom_single_iso_setup

def hom_complex
  (P : bounded_homotopy_category C) (B : C) :=
((preadditive_yoneda.obj B).map_homological_complex _).obj P.val.as.op

def map_hom_complex
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) :
  hom_complex P₂ B ⟶ hom_complex P₁ B :=
(((preadditive_yoneda.obj B).map_homological_complex _).map
  (homological_complex.op_functor.map f.out.op))

def map_hom_complex'
  (P : bounded_homotopy_category C) {B₁ B₂ : C} (f : B₁ ⟶ B₂) :
  hom_complex P B₁ ⟶ hom_complex P B₂ :=
(nat_trans.map_homological_complex (preadditive_yoneda.map f) _).app _

def aux₁
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  homology
    ((hom_complex P B).d (i+1) i)
    ((hom_complex P B).d i (i-1))
    ((hom_complex P B).d_comp_d _ _ _) ≅
  (hom_complex P B).homology i :=
(homology_iso' (hom_complex P B) (i+1) i (i-1) (by simp) (by simp)).symm

def map_homology
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  homology ((hom_complex P₂ B).d (i + 1) i) ((hom_complex P₂ B).d i (i - 1))
    ((hom_complex _ B).d_comp_d _ _ _) ⟶
  homology ((hom_complex P₁ B).d (i + 1) i) ((hom_complex P₁ B).d i (i - 1))
    ((hom_complex _ B).d_comp_d _ _ _) :=
homology.map _ _
(arrow.hom_mk $ (map_hom_complex f B).comm _ _)
(arrow.hom_mk $ (map_hom_complex f B).comm _ _)
rfl

lemma aux₁_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (aux₁ P₂ B i).hom ≫ (homology_functor _ _ _).map (map_hom_complex f B) =
  (map_homology f _ _) ≫ (aux₁ P₁ B i).hom :=
begin
  dsimp only [map_homology, aux₁, homology_iso', iso.symm_hom, homology.map_iso,
    homology_functor_map],
  rw homology.map_eq_desc'_lift_left,
  rw homology.map_eq_lift_desc'_left,
  rw homology.map_eq_desc'_lift_left,
  rw homology.map_eq_lift_desc'_left,
  apply homology.hom_from_ext, apply homology.hom_to_ext,
  simp only [homology.π'_desc', category.assoc, homology.π'_desc'_assoc,
    homology.lift_ι, homology.lift_ι_assoc],
  let t := _, change t ≫ _ = _,
  have ht : t = kernel.lift _ (kernel.ι _) _ ≫ homology.π' _ _ _,
  rotate 2,
  { rw homological_complex.d_from_eq,
    rw [kernel.condition_assoc, zero_comp],
    simp, },
  { apply homology.hom_to_ext,
    simp, dsimp, simp },
  rw ht, clear ht, clear t,
  simp only [kernel.lift_ι_assoc, category.assoc, arrow.hom_mk_left, arrow.iso_mk_inv_left,
    iso.refl_inv, homological_complex.hom.sq_from_left, homology.π'_desc'],
  let t := _, change _ = _ ≫ t,
  have ht : t = homology.ι _ _ _ ≫ cokernel.desc _ (cokernel.π _) _,
  rotate 2,
  { have := (hom_complex P₁ B).d_to_eq (by simp : (complex_shape.up ℤ).symm.rel (i+1) i),
    rw ← iso.inv_comp_eq at this,
    rw [← this, category.assoc, cokernel.condition, comp_zero] },
  { apply homology.hom_from_ext,
    simp, dsimp, simp },
  rw ht, clear ht, clear t,
  simp only [category.assoc, cokernel.π_desc, homology.lift_ι_assoc],
end

def aux₂
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  homology
    ((hom_complex P B).d (i+1) i)
    ((hom_complex P B).d i (i-1))
    (homological_complex.d_comp_d _ _ _ _) ≅
  AddCommGroup.homology ((hom_complex P B).d (i+1) i) ((hom_complex P B).d i (i-1)) :=
(AddCommGroup.homology_iso _ _ _)

def ker_hom
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  ((hom_complex P₂ B).d i (i - 1)).ker →+
  ((hom_complex P₁ B).d i (i - 1)).ker :=
{ to_fun := λ x, ⟨(map_hom_complex f B).f _ ↑x, begin
    change _ = _,
    have : _ = _ := x.2,
    dsimp [hom_complex, map_hom_complex] at *,
    rw [← category.assoc, ← f.out.comm, category.assoc, this, comp_zero],
  end⟩,
  map_zero' := by { ext, simp },
  map_add' := begin
    intros x y, ext, dsimp [map_hom_complex], simp,
  end }

def map_explicit_homology
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  AddCommGroup.homology ((hom_complex P₂ B).d (i+1) i) ((hom_complex P₂ B).d i (i-1)) ⟶
  AddCommGroup.homology ((hom_complex P₁ B).d (i+1) i) ((hom_complex P₁ B).d i (i-1)) :=
quotient_add_group.lift _
(add_monoid_hom.comp (quotient_add_group.mk' _) $ ker_hom f _ _)
begin
  rintros ⟨x,(hx : _ = _)⟩ hh,
  dsimp [ker_hom, map_hom_complex],
  rw quotient_add_group.eq_zero_iff,
  rw add_subgroup.mem_comap at *, dsimp at *,
  change ∃ e, _,
  obtain ⟨e,he⟩ := hh,
  dsimp [hom_complex] at *,
  use f.out.f _ ≫ e,
  rw [← category.assoc, ← f.out.comm, category.assoc, he],
end

--TODO: This relates the above construction to AddcommGroup.homology_map
-- the above def has more convenient defeq properties for some of the proofs below, but
-- the `AddCommGroup.homology_map` is better suited for `aux₂_naturality`.
lemma map_explicit_homology_eq
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  map_explicit_homology f B i =
  AddCommGroup.homology_map
    ((hom_complex P₂ B).d_comp_d _ _ _)
    ((hom_complex P₁ B).d_comp_d _ _ _)
    (commsq.of_eq $ ((map_hom_complex f B).comm (i+1) i).symm)
    (commsq.of_eq $ ((map_hom_complex f B).comm i (i-1)).symm) :=
begin
  ext ⟨t⟩,
  symmetry, apply AddCommGroup.homology_map_apply_mk,
end

lemma aux₂_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (aux₂ P₂ B i).hom ≫ map_explicit_homology f _ _ =
  map_homology f _ _ ≫ (aux₂ P₁ B i).hom :=
begin
  rw map_explicit_homology_eq,
  dsimp [aux₂],
  dsimp [AddCommGroup.homology_iso, AddCommGroup.homology_map, map_homology],
  generalize_proofs _ _ w _ w',
  apply (homology.has _ _ w).ext_π,
  apply (AddCommGroup.has_homology _ _ w').ext_ι,
  rw has_homology.homology_map_eq,
  simp only [has_homology.π_map, category.assoc, has_homology.π_map_assoc,
    has_homology.map_ι, has_homology.map_ι_assoc],
  let t := _, change t ≫ _ = _,
  have ht : t = kernel.lift _ (kernel.ι _) _ ≫ (AddCommGroup.has_homology _ _ w).π,
  rotate 2,
  { apply kernel.condition },
  { apply (AddCommGroup.has_homology _ _ w).ext_ι,
    simp [has_homology.π_ι] },
  rw ht, clear ht, clear t,
  let t := _, change _ = _ ≫ t,
  have ht : t = (homology.has _ _ w').ι ≫ cokernel.desc _ (cokernel.π _) _,
  rotate 2,
  { apply cokernel.condition },
  { apply (homology.has _ _ w').ext_π,
    rw [← category.assoc, has_homology.π_ι],
    simp },
  rw ht, clear ht, clear t,
  simp,
end

lemma aux₂_naturality_inv
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  map_explicit_homology f _ _ ≫ (aux₂ P₁ B i).inv =
  (aux₂ P₂ B i).inv ≫  map_homology f _ _ :=
by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, aux₂_naturality]

def aux₃
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  (P ⟶ (single C i).obj B) ≃+
  AddCommGroup.homology ((hom_complex P B).d (i+1) i) ((hom_complex P B).d i (i-1)) :=
begin
  refine add_equiv.surjective_congr (homological_complex.hom_single_iso P.val.as B i)
    (homotopy_category.quotient_map_hom _ _)
    (quotient_add_group.mk' _) (quot.mk_surjective _) (quot.mk_surjective _) _,
  ext f,
  dsimp,
  simp only [homotopy_category.quotient_map_hom, quotient_add_group.ker_mk,
    add_equiv.coe_to_add_monoid_hom, add_monoid_hom.mem_ker, add_subgroup.mem_comap,
    add_subgroup.coe_subtype, add_monoid_hom.mk'_apply, add_subgroup.coe_mk,
    add_equiv.coe_mk, add_monoid_hom.mem_range],
  rw ← (homotopy_category.quotient _ _).map_zero,
  any_goals { apply_instance },
  erw quotient.functor_map_eq_iff,
  rw homotopic_to_single_iff (show (complex_shape.up ℤ).rel i (i+1), from rfl),
  apply exists_congr,
  intro g,
  simp only [add_zero, quiver.hom.unop_op, linear_map.to_add_monoid_hom_coe,
    preadditive_yoneda_obj_map_apply, homological_complex.zero_f_apply,
    homological_complex.hom_single_iso_apply_coe],
  rw [← is_iso.comp_inv_eq, eq_comm],
  split,
  { intro h,
    rw [h, is_iso.comp_inv_eq, category.assoc, category.assoc, eq_to_hom_trans,
      eq_to_hom_refl, category.comp_id],
    refl },
  { intro h,
    rw [h, is_iso.eq_comp_inv, category.assoc, category.assoc, eq_to_hom_trans,
      eq_to_hom_refl, category.comp_id],
    refl }
end

lemma aux₃_apply
  (P : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P ⟶ (single C i).obj B) :
  aux₃ P B i f = quotient_add_group.mk ⟨f.out.f i ≫ eq_to_hom (if_pos rfl), begin
    change _ = _, dsimp [hom_complex],
    rw [← category.assoc, ← f.out.comm, category.assoc],
    convert zero_comp,
    apply is_zero.eq_of_tgt, convert is_zero_zero _,
    dsimp [single], rw if_neg, simp,
  end⟩ := rfl

lemma aux₃_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (map_explicit_homology f B i).comp (aux₃ P₂ B i).to_add_monoid_hom =
  add_monoid_hom.comp (aux₃ P₁ B i).to_add_monoid_hom ((preadditive_yoneda.obj _).map f.op) :=
begin
  ext ⟨x⟩,
  dsimp, simp_rw aux₃_apply,
  dsimp [map_explicit_homology, ker_hom, map_hom_complex],
  rw ← sub_eq_zero,
  erw quotient_add_group.eq_zero_iff,
  rw [add_subgroup.mem_comap],
  dsimp,
  -- now we need to use a homotopy...
  simp_rw [← category.assoc, ← homological_complex.comp_f],
  let t := _, let s := _, change homological_complex.hom.f t i ≫ _ -
    homological_complex.hom.f s i ≫ _ ∈ _,
  let hh : homotopy t s := begin
    apply homotopy_category.homotopy_of_eq,
    simpa,
  end,
  let e := hh.hom (i+1) i,
  change ∃ e, _,
  dsimp [hom_complex],
  use e ≫ eq_to_hom (if_pos rfl),
  rw [← preadditive.sub_comp _ _ (eq_to_hom _), ← category.assoc,
    ← homological_complex.comp_f], congr' 1,
  erw hh.comm i,
  simp only [homological_complex.cochain_complex_d_next,
    homological_complex.cochain_complex_prev_d, add_sub_cancel,
    self_eq_add_right],
  exact comp_zero,
end

lemma comp_add_equiv_iso_AddcommGroup_iso_eq_comp
  (X X' B : AddCommGroup.{u}) (e' : X' ≃+ B) (f : X ⟶ X') :
  f ≫ (add_equiv_iso_AddCommGroup_iso.hom e').hom =
  e'.to_add_monoid_hom.comp f := rfl

def hom_mk {A B : Type u} [add_comm_group A] [add_comm_group B] (f : A →+ B) :
  (AddCommGroup.of A) ⟶ (AddCommGroup.of B) := f

end hom_single_iso_setup

open hom_single_iso_setup

noncomputable
def hom_single_iso
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  AddCommGroup.of (P ⟶ (bounded_homotopy_category.single C i).obj B) ≅
  (((preadditive_yoneda.obj B).map_homological_complex _).obj P.val.as.op).homology i :=
begin
  refine _ ≪≫ aux₁ P B i,
  refine add_equiv_iso_AddCommGroup_iso.hom _ ≪≫ (aux₂ P B i).symm,
  exact aux₃ P B i,
end

.

open opposite

variables {X Y Z : cochain_complex C ℤ} (f : X ⟶ Y) (g : Y ⟶ Z)

def of' (X : cochain_complex C ℤ)
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj X)] :
  bounded_homotopy_category C :=
of $ (homotopy_category.quotient _ _).obj X

def of_hom (f : X ⟶ Y)
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj X)]
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj Y)] :
  of' X ⟶ of' Y :=
(homotopy_category.quotient _ _).map f

instance val_as_bdd_above (P : bounded_homotopy_category C) :
  ((homotopy_category.quotient C (complex_shape.up ℤ)).obj P.val.as).is_bounded_above :=
by { rcases P with ⟨P, ⟨a, ha⟩⟩, use a, intros i hi, exact ha i hi }

lemma hom_single_iso_naturality
  (P₁ P₂ : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P₁ ⟶ P₂) :
  (preadditive_yoneda.obj _).map f.op ≫ (hom_single_iso P₁ B i).hom =
  (hom_single_iso P₂ B i).hom ≫
  (((preadditive_yoneda.obj B).right_op.map_homological_complex _ ⋙
      homological_complex.unop_functor.right_op ⋙
      (_root_.homology_functor _ _ _).op).map f.out).unop :=
begin
  dsimp only [hom_single_iso, iso.trans_hom, iso.symm_hom, functor.comp_map, functor.op_map,
    functor.right_op_map, quiver.hom.unop_op],
  simp_rw [← category.assoc, comp_add_equiv_iso_AddcommGroup_iso_eq_comp],
  rw ← aux₃_naturality,
  rw [category.assoc],

  let t := hom_mk (aux₃ P₂ B i).to_add_monoid_hom,
  change (t ≫ (map_explicit_homology f B i)) ≫ _ ≫ _ = _,
  slice_lhs 2 3
  { rw aux₂_naturality_inv },
  simp_rw category.assoc,
  rw ← aux₁_naturality,
  refl,
end

lemma hom_single_iso_naturality'
  (P₁ P₂ : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P₁.val.as ⟶ P₂.val.as) :
  (preadditive_yoneda.obj ((single C i).obj B)).map (of_hom f).op ≫ (hom_single_iso P₁ B i).hom =
  (hom_single_iso P₂ B i).hom ≫
  (((preadditive_yoneda.obj B).right_op.map_homological_complex _ ⋙
      homological_complex.unop_functor.right_op ⋙
      (_root_.homology_functor _ _ _).op).map f).unop :=
begin
  erw hom_single_iso_naturality P₁ P₂ B i (of_hom f),
  refine congr_arg2 _ rfl _,
  apply homology_map_eq_of_homotopy,
  let h := (preadditive_yoneda.obj B).right_op.map_homotopy (homotopy_category.homotopy_out_map f),
  refine ⟨λ i j, (h.hom j i).unop, _, _⟩,
  { intros i j hij, rw [h.zero, unop_zero], exact hij },
  { intros i,
    conv_rhs { congr, rw add_comm, },
    convert congr_arg quiver.hom.unop (h.comm i),
    { dsimp [op_equiv, prev_d, d_next],
      have hi := (complex_shape.up ℤ).next_eq_some (show i+1=i+1, by refl),
      have hi' := (complex_shape.up ℤ).symm.prev_eq_some (show i+1=i+1, by refl),
      simpa only [hi, hi'], },
    { dsimp [op_equiv, prev_d, d_next],
      have hi := (complex_shape.up ℤ).prev_eq_some (show i-1+1=i, by linarith),
      have hi' := (complex_shape.up ℤ).symm.next_eq_some (show i-1+1=i, by linarith),
      simpa only [hi, hi'], }, },
end

def map_hom_complex_homology
  (P : bounded_homotopy_category C) {B₁ B₂ : C} (i : ℤ) (f : B₁ ⟶ B₂) (w₁ w₂) :
  homology ((hom_complex P B₁).d (i + 1) i) ((hom_complex P B₁).d i (i - 1)) w₁ ⟶
  homology ((hom_complex P B₂).d (i + 1) i) ((hom_complex P B₂).d i (i - 1)) w₂ :=
homology.map _ _
  (arrow.hom_mk ((map_hom_complex' _ f).comm _ _))
  (arrow.hom_mk ((map_hom_complex' _ f).comm _ _)) rfl

end bounded_homotopy_category


import temporal_logic.fairness
import temporal_logic.pair
import temporal_logic.lemmas

universe variables u u₀ u₁ u₂
open predicate nat

namespace temporal

namespace simulation
section

parameters {α : Type u} {β : Type u₀} {γ : Type u₁ }
parameters (p : pred' (γ×α)) (q : pred' (γ×β))
parameters (A : act (γ×α)) (C : act (γ×β))
parameters (J : pred' (γ×α×β))

variables (x : tvar α) (y : tvar β) (z : tvar γ)

def SPEC₀ (v : tvar α) (o : tvar γ) : cpred :=
p ! ⦃ o,v ⦄ ⋀
◻⟦ o,v | A ⟧

def SPEC₁ (v : tvar β) (o : tvar γ) : cpred :=
q ! ⦃ o,v ⦄ ⋀
◻⟦ o,v | C ⟧

-- parameters [inhabited α]
parameter SIM₀ : ∀ v o, (o,v) ⊨ q → ∃ w, (o,w) ⊨ p ∧ (o,w,v) ⊨ J
parameter SIM
: ∀ w v o v' o',
  (o,w,v) ⊨ J →
  C (o,v) (o',v') →
  ∃ w', A (o,w) (o',w') ∧
        (o',w',v') ⊨ J

parameters (v : tvar β) (o : tvar γ)

parameters Γ : cpred
parameters H : Γ ⊢ SPEC₁ v o

def Wx₀ : tvar (α → Prop) :=
[| o, λ w, (o,w) ⊨ p |]

def Wf : tvar (α → α → Prop) :=
⟪ ℕ, λ o o' w w', A (o,w) (o',w') ⟫ o (⊙o)

def Wtn (w : tvar α) :=
Wx₀ w ⋀ ◻(Wf w ⊙w)

include SIM₀

variables w : tvar α
-- variables Hw : Γ ⊢ Wtn w
-- include Hw

include H SIM
-- omit Hw

#check to_fun_var
#check to_fun_var'

lemma simulation
: Γ ⊢ ∃∃ w, SPEC₀ w o :=
begin [temporal]
  cases H with H₀ Hnext,
  -- ⊢ ⇑(⇑(to_fun_var' (λ (w w_1 : tvar α), ⇑(⇑Wf w) w_1)) w) w' = ⇑(⇑Wf w) w'
  select_witness w : temporal.simulation.Wtn w
    with Hw hJ
    using (J!⦃o,w,v⦄), { },
  explicit' [SPEC₀,Wx₀] with H₀
    { solve_by_elim, } ,
  -- intros,
  explicit' [Wf] with Hnext
  { intros, apply SIM ; assumption, },
  existsi w, revert Hw,
  simp only [SPEC₀,SPEC₁,Wtn],
  apply ctx_p_and_p_imp_p_and',
  explicit' [Wx₀] {  },
  mono!,
  explicit' [Wf] {  },
end

omit H
lemma simulation'
: (∃∃ c, SPEC₁ c o) ⟹ (∃∃ a, SPEC₀ a o) :=
begin [temporal]
  rw p_exists_p_imp,
  intros x h,
  apply simulation p q A C J SIM₀ @SIM _ _ _ h ,
end

end
end simulation

export simulation (simulation simulation')

namespace witness_construction
section witness_construction

parameters {α : Sort u}
parameters {p J : pred' α}
parameters {A : act α}

parameters H₀ : p ⟹ J
parameters FIS₀ : ∃ σ, σ ⊨ p
parameters FIS : ∀ σ, σ ⊨ J → ∃ σ', A σ σ'
parameters INV : ∀ σ σ', σ ⊨ J → A σ σ' → σ' ⊨ J

open classical simulation function

include H₀ INV

def A' : act $ unit × plift α :=
A on (plift.down ∘ prod.snd)

-- parameters [_inst : inhabited α]

include FIS₀ FIS
lemma witness_construction
: ⊩ ∃∃ v, p ! v ⋀ ◻⟦ v | A ⟧ :=
begin
  intro,
  let o : tvar unit := ↑(),
  let C : unit × unit → unit × unit → Prop := λ _ _, true,
  let prj : var (unit × plift α) α := ⟨plift.down⟩ ! pair.snd,
  let p' : pred' (unit × plift α) := p ! prj,
  -- cases FIS₀ with w Hw,
  -- have _inst : inhabited (plift α) := ⟨ plift.up w ⟩,
  let J' : pred' (unit × plift α × unit) := J ! ⟨plift.down⟩ ! pair.fst ! pair.snd,
  have := @simulation _ _ _ p' (@True $ unit × unit) (A' H₀ INV) C J' _ _ o o Γ _,
  -- ; try { auto },
  -- have := @simulation _ _ _ _ (@True $ unit × unit) (A' H₀ INV) C J' True _inst _ _ o o Γ _,
  begin [temporal]
    revert this,
    let f : tvar (plift α) → tvar α := λ v, ⟨plift.down⟩ ! v,
    let SPEC := @SPEC₀ _ _ p' (A' H₀ INV),
    let SPEC' := λ (v : tvar α), p ! v ⋀ ◻⟦ v | A ⟧,
    apply p_exists_imp_p_exists' (λ w, SPEC w o) SPEC' f,
    intro, simp only [SPEC,f,SPEC',SPEC₀,p',prj,proj_assoc,pair.snd_mk,A'],
    monotonicity, rw [action_on,coe_over_comp,proj_assoc,pair.snd_mk'],
    refl,
  end,
  { intros,
    apply exists_imp_exists' plift.up _ FIS₀,
    introv Hw, split, simp [p',Hw],
    simp [J'], apply ew_str H₀ _ Hw, },
  { introv hJ hC, simp [J'] at hJ,
    -- existsi w,
    have := FIS _ hJ, revert this,
    apply exists_imp_exists' plift.up,
    simp [A',function.comp,on_fun], introv hA, split,
    { apply hA },
    { apply INV _ _ hJ hA  } },
  { simp only [SPEC₁,C] with tl_simp, }
end

end witness_construction
end witness_construction

end temporal


import Scratch.ExprRw
import Scratch.TermSeq
import Scratch.ConstDeps
import Lean.Meta
open Lean
open Meta
open Lean.Elab.Tactic
open Elab

def exprPieces : Expr → MetaM (List Expr)
  | Expr.app f a _ =>
    do
      let ft ← inferType f
      let expl := ft.data.binderInfo.isExplicit
      if expl then
      (←  exprPieces f) ++ (← exprPieces a) ++ [f, a]
      else [f]
  | e => try
            return [e]
        catch _ => []

def types : List Expr → MetaM (List Expr) :=
    fun l =>
    match l with
    | [] => return []
    | h::t => do
      let h ← inferType h
      let t ← types t
      return (h::t)

def factorThrough(α : Sort u) (β : Sort v)(b : β ) : (β  → α ) → α   :=
    fun g => g b

def addToContextM(name: Name) (type : Expr)(value: Expr) :
     MVarId → MetaM (List MVarId) :=
  fun m =>
      do
        let target ← getMVarType m
        let exp ← mkAppM `factorThrough #[target, type, value]
        let appGoalList ←  apply m exp
        let appGoal := appGoalList.head!
        let ⟨_, introGoal⟩ ←  intro appGoal name
        return [introGoal]

def addAllToContextM (values : List Expr) :
     MVarId → MetaM (List MVarId) :=
     match values with
      | [] => fun m => return [m]
      | h::t => fun m =>
        do
          let newMVarIds ← addToContextM Name.anonymous (← inferType h) h m
          addAllToContextM t newMVarIds.head!

def generateSeek(n: Nat)(saveOpt: Option Name)
      (initState: Array Expr)(goalNames : List Name)(mvar: MVarId)
      (dynamics : Nat → Array Expr → Array Name → TermElabM (Array Expr)) : TacticM Unit :=
              withMVarContext mvar do
          logInfo m!"starting generation: {← IO.monoMsNow}"
          let target ←  getMVarType mvar
          let init := initState
          let baseEvolved ← dynamics n  init goalNames.toArray
          -- logInfo m!"evolved elements: {baseEvolved.size}"
          let mut evolved : Array Expr := #[]
          -- let mut evolvedTypes : Array Expr := #[]
          for e in baseEvolved do
            let exp ← whnf $ ← reduce e
            unless evolved.contains exp do
              evolved :=  evolved.push exp
            let type ← inferType exp
            let type ← whnf $ ← reduce type
          let found ← evolved.findM? (fun e => do isDefEq (← inferType e) target)
          match found with
          | some x =>
            do
              -- logInfo m!"found : {x}"
              -- logInfo m!"found-type: {← inferType x}"
              assignExprMVar mvar x
              replaceMainGoal []
          | none =>
            replaceMainGoal [mvar]
          match saveOpt with
            | some name => saveExprArr name evolved
            | none => return ()
          logInfo m!"completed generation: {← IO.monoMsNow}"
          return ()

syntax (name:= introsRwFind) "introsRwFind" (num ("save:" ident)?)?: tactic
@[tactic introsRwFind] def introsRwfindImpl : Tactic :=
  fun stx  =>
  match stx with
  | `(tactic|introsRwFind) =>
    introsRWAux 1 none
  | `(tactic|introsRwFind $t) =>
    withMainContext do
      let n : Nat <- t.isNatLit?.getD 0
      introsRWAux n none
  | `(tactic|introsRwFind $t save:$name) =>
    withMainContext do
      let n : Nat <- t.isNatLit?.getD 0
      let name ← name.getId
      introsRWAux n (some name)
  | _ => Elab.throwIllFormedSyntax
      where introsRWAux (n: Nat)(saveOpt: Option Name) : TacticM Unit :=
        withMainContext do
        let mvar ← getMainGoal
        let goalNames ← ConstDeps.recExprNames (← getEnv) (← getMainTarget)
        let ⟨introVars, codmvar⟩ ← Meta.intros mvar
        let introFreeVars := introVars.map (fun x => mkFVar x)
        logInfo m!"goalNames : {goalNames}"
        generateSeek n saveOpt introFreeVars goalNames codmvar iterAppRWTask

declare_syntax_cat init_source
syntax "#⟨" term,* "⟩" : init_source
syntax "load:" ident : init_source

syntax (name:= polyFind) "polyFind" init_source (num)?
      ("save:" ident)?: tactic
@[tactic polyFind] def polyfindImpl : Tactic :=
  fun stx  =>
  match stx with
  | `(tactic|polyFind $s:init_source) =>
    withMainContext do
    let initState ←  getInit s
    polyFindAux  initState 1 none
  | `(tactic| polyFind $s:init_source $t:numLit save:$name) =>
    withMainContext do
    let initState ←  getInit s
    let n : Nat <- t.isNatLit?.getD 0
    polyFindAux  initState n (some name.getId)
  | `(tactic| polyFind $s:init_source $t:numLit) =>
    withMainContext do
    let initState ←  getInit s
    let n : Nat <- t.isNatLit?.getD 0
    polyFindAux  initState n none
  | _ => Elab.throwIllFormedSyntax
      where
      polyFindAux  (initState: Array Expr)
          (n: Nat)(saveOpt: Option Name) : TacticM Unit :=
        withMainContext do
        let mvar ← getMainGoal
        let goalNames ← ConstDeps.recExprNames (← getEnv) (← getMainTarget)
        generateSeek n saveOpt  initState goalNames mvar iterAppRWTask
      getInit (stx: Syntax) : TacticM (Array Expr) :=
        match stx with
        | `(init_source|#⟨$[$xs:term],*⟩) =>
          withMainContext do
          let initState ←  xs.mapM (fun x => elabTerm x none)
          return initState
        | `(init_source|load:$name:ident) =>
          loadedState name.getId
        | s => do
          logInfo m!"unexpected syntax {s}"
          return #[]
          -- throwIllFormedSyntax
      loadedState (name : Name) : TacticM (Array Expr) :=
        withMainContext do loadExprArr name

def modusPonens : {α β : Type} →  α → (α → β) → β := by
      introsRwFind 1 save:blah

example {α β : Type} : α → (α → β) → β := by
    intros x f
    polyFind #⟨x, f⟩

def modus_ponens (α β : Prop) : α → (α → β) → β := by
      introsRwFind

def blah := loadExprArr `blah

def blahTypes : TermElabM (Array Expr) := do
    let es ←  blah
    return ← es.mapM (fun e => inferType e)

-- #eval blahTypes
-- #eval blah

#print modusPonens
#print modus_ponens

def constantFunction (α β : Type)  : α → β → α  := by
      introsRwFind

def constant_implication (α β : Prop)  : α → β → α := by
      introsRwFind

def reflImpl (α : Prop) : α → α  := by
      introsRwFind

def autoId (α : Type) : α → α := by
      introsRwFind

#print autoId

theorem doubleMP{α β γ : Prop} : α → (α → β) →  (β →  γ) → γ  := by
      introsRwFind 2

def transPf {α : Type}{a b c : α}(f: α → Nat) :
          a = b → b = c → a = c := by
          introsRwFind

theorem idsEqual{μ : Type}{mul: μ → μ → μ}:
      (eₗ : μ) → (eᵣ : μ) → (leftId : (x : μ ) →  mul eₗ x = x) →
      (rightId : (x : μ ) →  mul x eᵣ = x) →
      eₗ = eᵣ := by
        introsRwFind 2

example {μ : Type}{mul: μ → μ → μ}:
      (eₗ : μ) → (eᵣ : μ) → (leftId : (x : μ ) →  mul eₗ x = x) →
      (rightId : (x : μ ) →  mul x eᵣ = x) →
      eₗ = eᵣ := by
        intros eₗ eᵣ lid rid
        polyFind #⟨eₗ, eᵣ, lid, rid⟩ 2 save:poly

example {μ : Type}{mul: μ → μ → μ}:
      (eₗ : μ) → (eᵣ : μ) → (leftId : (x : μ ) →  mul eₗ x = x) →
      (rightId : (x : μ ) →  mul x eᵣ = x) →
      eₗ = eᵣ := by
        intros eₗ eᵣ lid rid
        polyFind #⟨eₗ, eᵣ, lid, rid⟩ 1 save:poly1
        polyFind load:poly1 1 save:poly2

-- deducing from equalities

syntax (name:= eqDeduc) "eqDeduc" ("#⟨" term,* "⟩") (num ("eqs:" ident)) ("save:" ident)?: tactic
@[tactic eqDeduc] def eqDeducImpl : Tactic :=
  fun stx  =>
  match stx with
  | `(tactic|eqDeduc #⟨$[$xs:term],*⟩ $t eqs: $name) =>
    withMainContext do
      let introFreeVars ←  xs.mapM (fun x => elabTerm x none)
      let n : Nat <- t.isNatLit?.getD 0
      let name ← name.getId
      let prevState ← loadedState name
      let goalNames ← ConstDeps.recExprNames (← getEnv) (← getMainTarget)
      let dynamics : Nat → Array Expr → Array Name → TermElabM (Array Expr) :=
        fun m init names => eqIsles prevState
        (fun list => (iterAppRWTask m list names)) init.toList
      let mvar ← getMainGoal
      generateSeek n none  introFreeVars goalNames mvar dynamics
  | `(tactic|eqDeduc #⟨$[$xs:term],*⟩ $t eqs: $name save:$saveName) =>
    withMainContext do
      let introFreeVars ←  xs.mapM (fun x => elabTerm x none)
      let n : Nat <- t.isNatLit?.getD 0
      let name ← name.getId
      let prevState ← loadedState name
      let goalNames ← ConstDeps.recExprNames (← getEnv) (← getMainTarget)
      let dynamics : Nat → Array Expr → Array Name → TermElabM (Array Expr) :=
        fun m init names => eqIsles prevState
        (fun list => (iterAppRWTask m list names)) init.toList
      let mvar ← getMainGoal
      generateSeek n (some saveName.getId) introFreeVars goalNames mvar dynamics
  | _ => Elab.throwIllFormedSyntax
  where
    loadedState (name: Name) : TacticM (Array Expr) :=
    withMainContext do
      let loadedState ←  loadExprArr name
      loadedState.mapM $ fun e => whnf e

syntax (name:= lookup) "lookup"  ident: tactic
@[tactic lookup] def lookupImpl : Tactic :=
  fun stx  =>
  match stx with
  | `(tactic| lookup $name) =>
    withMainContext do
      let name ← name.getId
      let loadState ← loadExprArr name
      let memo ← loadState.mapM $ fun e => do whnf e
      let mvar ← getMainGoal
      let target ← getMainTarget
      let found ← memo.findM? (fun e => do isDefEq (← inferType e) target)
          match found with
          | some x =>
            do
              -- logInfo m!"found : {x}"
              -- logInfo m!"found-type: {← inferType x}"
              assignExprMVar mvar x
              replaceMainGoal []
          | none =>
            replaceMainGoal [mvar]
          return ()
  | _ =>  Elab.throwIllFormedSyntax

syntax (name:= propeqs) "propeqs"  ident: tactic
@[tactic propeqs] def propeqsImpl : Tactic :=
  fun stx  =>
  match stx with
  | `(tactic| propeqs $name) =>
    withMainContext do
      logInfo m!"started equality propagation: {← IO.monoMsNow}"
      let name ← name.getId
      let loadState ← loadExprArr name
      let initState ← loadState.mapM $ fun e => do whnf e
      let mvar ← getMainGoal
      let target ← getMainTarget
      logInfo m!"loaded equalities for propagation: {← IO.monoMsNow}"
      let evolved ← propagateEqualities initState
      logInfo m!"propagated equalities: {← IO.monoMsNow}\ngot: {evolved.size}"
      let found ← evolved.find? target
      logInfo m!"completed search: {← IO.monoMsNow}"
      match found with
      | some x =>
        do
          logInfo m!"found : {x}"
          logInfo m!"found-type: {← inferType x}"
          assignExprMVar mvar x
          replaceMainGoal []
      | none =>
        replaceMainGoal [mvar]
      return ()
  | _ =>  Elab.throwIllFormedSyntax


import ..transition.transition

/- Defining the six channels of the ABP.-/
@[derive decidable_eq]
inductive Int_Channels : Type
| B : Int_Channels
| C : Int_Channels

@[derive decidable_eq]
inductive Ack_Channels : Type
| E : Ack_Channels
| F : Ack_Channels

@[derive decidable_eq]
inductive Ext_Channels : Type
| A : Ext_Channels
| D : Ext_Channels

/- The Args type denotes the arguments of sending and receiving, according to which channel is doing the actions.-/
@[derive decidable_eq]
inductive Args (α : Type) [decidable_eq α] : Type
| Int : Int_Channels → option (α × bool) → Args
| Ext : Ext_Channels → α → Args
| Ack : Ack_Channels → option bool → Args

/- An action is a send, receive or communication with a corresponding argument, or the j filler action.-/
inductive Act (α : Type) [decidable_eq α] : Type
| zero : Act
| j : Act
| r : Args α → Act
| s : Args α → Act
| c : Args α → Act

variable {α : Type}
variable [decidable_eq α]

/- Here we set up the comm_semigroup_with_zero for the actions of the ABP-/
namespace Act

def mul : Act α → Act α → Act α
| (r x) (s y) := if x = y then c x else zero
| (s x) (r y) := if x = y then c x else zero
| _ _ := zero

lemma mul_zero (x : Act α) :
mul x zero = zero := by cases x; refl

lemma zero_mul (x : Act α) :
mul zero x = zero := by cases x; refl

lemma mul_comm :
commutative (@mul α _) :=
begin
  intros x y,
  cases x; cases y; unfold mul; split_ifs,
  repeat {refl},
  repeat {assumption},
  repeat {simp [h, h_1] at *, assumption}
end

lemma mul_assoc :
associative (@mul α _) :=
begin
  intros x y z,
  cases x; cases y; cases z; unfold mul; split_ifs; refl
end

instance semigroup : comm_semigroup_with_zero (Act α) := {
   zero := zero,
   mul := mul,
   mul_assoc := mul_assoc,
   mul_zero := mul_zero,
   zero_mul := zero_mul,
   mul_comm := mul_comm
}

end Act