import polytime
open num (to_bits of_bits)

@[simp] def encode_option_nat : option ℕ → ℕ
| none := 0
| (some n) := bit1 n

@[simp] def decode_option_nat : ℕ → option ℕ
| 0 := none
| n := some (of_bits (to_bits n).tail)

@[simp] lemma decode_option_nat_bit1 (n : ℕ) : decode_option_nat (bit1 n) = some n :=
by { cases e : (bit1 n), { simp at e, contradiction, },
  simp only [decode_option_nat, nat.succ_ne_zero, not_false_iff], rw ← e, simp, }

@[simp] lemma decode_encode_option_nat (n : option ℕ) : decode_option_nat (encode_option_nat n) = n :=
by { cases n, { refl, }, simp, }

class polycodable (α : Type*) :=
(encode : α → ℕ)
(decode [] : ℕ → option α)
(decode_encode : ∀ x, decode (encode x) = some x)
(poly [] : ∃ c : code, polytime c ∧ ∀ x, c.eval x =  part.some (encode_option_nat ((decode x).map encode)))

attribute [simp] polycodable.decode_encode

open polycodable

instance : polycodable ℕ :=
{ encode := id,
  decode := some,
  decode_encode := λ n, rfl,
  poly := ⟨code.bit tt, polytime_bit _, λ n, by simp [nat.bit]⟩ }

@[simp] lemma encode_nat_id (n : ℕ) : encode n = n := rfl
@[simp] lemma decode_nat_id (n : ℕ) : decode ℕ n = some n := rfl

def decode_option_code (f : code) : code :=
code.case ((code.case zero (code.bit tt) zero).comp f) ((code.case zero (code.bit tt) zero).comp f) zero

lemma polytime_decode_option_code {f : code} (hf : polytime f) : polytime (decode_option_code f) :=
begin
  -- TODO: This obviously needs to be a tactic
  apply polytime_case,
  { apply polytime_comp, { apply polytime_case, apply polytime_zero, apply polytime_bit, apply polytime_zero, }, exact hf, },
  apply polytime_comp, apply polytime_case, apply polytime_zero, apply polytime_bit, apply polytime_zero, exact hf, apply polytime_zero,
end

instance {α : Type} [polycodable α] : polycodable (option α) :=
{ encode := λ x, encode_option_nat (x.map encode),
  decode := λ x, some ((decode_option_nat x) >>= decode α),
  decode_encode := λ x, by cases x; simp,
  poly :=
  begin
    obtain ⟨c, pc, ec⟩ := polycodable.poly α,
    use (code.bit tt).comp (decode_option_code c), split,
    { apply polytime_comp (polytime_bit _), exact polytime_decode_option_code pc, },
    intro x, simp only [decode_option_code],
    rcases e : (to_bits x) with _|_|_,
    { simp only [num.to_bits_nil_iff, nat.cast_eq_zero] at e, subst e, simp [nat.bit], },
    all_goals { have : x ≠ 0 := λ h, by { subst h, simpa using e, },
      simp [e, this, nat.bit, ec],
      cases decode α (of_bits this_tl); simp, },
  end  }

def is_polytime {α β : Type} [polycodable α] [polycodable β] (f : α → β) : Prop :=
∃ c : code, polytime c ∧ ∀ x, c.eval (encode x) = part.some (encode $ f x)

@[simps] def polycodable.mk' {α : Type} (encode : α → ℕ) (decode : ℕ → option α) (decode_encode : ∀ x, decode (encode x) = some x)
  (poly : is_polytime (λ x, (decode x).map encode)) : polycodable α :=
{ encode := encode,
  decode := decode,
  decode_encode := decode_encode,
  poly := by simpa [is_polytime, polycodable.encode] using poly }

variables {α β γ : Type} [polycodable α] [polycodable β] [polycodable γ]

lemma encode_decode_is_polytime (α : Type) [polycodable α] : is_polytime (λ x : ℕ, (decode α x).map encode) :=
by simpa [is_polytime, polycodable.encode] using poly α

lemma is_polytime_iff (f : α → β) :
  is_polytime f ↔ ∃ c : code, polytime c ∧ ∀ x : ℕ, c.eval x = part.some (encode $ (decode α x).map f) :=
begin
  split, swap,
  { rintro ⟨c, pc, hc⟩,
    use tail.comp c,
    split, { exact polytime_comp polytime_tail pc,},
    intro x, specialize hc (encode x),
    simp [hc, polycodable.encode], },
  rintro ⟨c, pc, hc⟩,
  obtain ⟨de, pde, hde⟩ := polycodable.poly α,
  use (code.case zero ((code.bit tt).comp c) zero).comp de,
  split, { exact polytime_comp (polytime_case polytime_zero (polytime_comp (polytime_bit _) pc) polytime_zero) pde, },
  intro x, specialize hde x,
  cases decode α x,
  { simp [hde], refl, }, simp [hde, hc], refl,
end

lemma is_polytime_comp {f : β → γ} {g : α → β} : is_polytime f → is_polytime g → is_polytime (f ∘ g)
| ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ := ⟨fc.comp gc, polytime_comp fp gp, λ x, by simp [hf, hg]⟩

lemma is_polytime_encode (α : Type) [polycodable α] : is_polytime (@encode α _) :=
⟨code.id, polytime_id, λ x, by simp⟩

lemma is_polytime_decode (α : Type) [polycodable α] : is_polytime (decode α) := poly α

lemma is_polytime_const (β : Type) [polycodable β] (x : α) : is_polytime (λ _ : β, x) :=
⟨code.const (encode x), polytime_const _, λ x, by simp⟩

section equiv

def polycodable_of_equiv {β : Type} (eqv : α ≃ β) : polycodable β :=
polycodable.mk'
  (λ b, (polycodable.encode (eqv.symm b)))
  (λ n, (polycodable.decode α n).map eqv)
  (λ b, by simp)
  (by { convert encode_decode_is_polytime α, ext b : 1, cases decode α b; simp, })

lemma is_polytime_of_equiv_symm {β : Type} (eqv : α ≃ β)
  {f : α → γ} (hf : is_polytime f) : @is_polytime β γ (polycodable_of_equiv eqv) _ (f ∘ eqv.symm) :=
by { rcases hf with ⟨c, pc, hc⟩, use c, split, { assumption, }, intro x, exact hc (eqv.symm x), }

lemma is_polytime_of_equiv {β : Type} (eqv : α ≃ β)
  {f : γ → α} (hf : is_polytime f) : @is_polytime γ β _ (polycodable_of_equiv eqv) (eqv ∘ f) :=
by { rcases hf with ⟨c, pc, hc⟩, use c, split, { assumption, }, intro x, rw hc x, simp [encode], }

end equiv

section bool

instance : polycodable bool :=
polycodable.mk'
(λ b, cond b 1 0) (λ n, some (if n = 0 then ff else tt)) (λ x, by cases x; simp)
⟨(code.bit tt).comp to_bit, polytime_comp (polytime_bit _) polytime_to_bit, λ x, by cases x; simp; refl⟩

lemma is_polytime_cond {c : α → bool} {f g : α → β} : is_polytime c → is_polytime f → is_polytime g → is_polytime (λ x, cond (c x) (f x) (g x))
| ⟨cc, cp, hc⟩ ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ :=
⟨code.ite cc gc fc, (polytime_ite cp gp fp), λ x, by cases e : c x; simp [hc, hf, hg, e]⟩

lemma is_polytime_is_some (α : Type) [polycodable α] : is_polytime (@option.is_some α) :=
⟨to_bit, polytime_to_bit, λ x, by cases x; simp [polycodable.encode]⟩

end bool

section prod

instance {α β : Type} [polycodable α] [polycodable β] : polycodable (α × β) :=
polycodable.mk'
  (λ x, nat.mkpair' (encode x.1) (encode x.2))
  (λ x, (decode α (nat.unpair' x).1) >>= (λ x₁, (decode β (nat.unpair' x).2).map $ λ x₂, (x₁, x₂)))
  (λ x, by simp [return, pure])
begin
  obtain ⟨somec₁, somep₁, hsome₁⟩ := is_polytime_is_some α,
  obtain ⟨somec₂, somep₂, hsome₂⟩ := is_polytime_is_some β,
  obtain ⟨d₁, dp₁, hd₁⟩ := is_polytime_decode α,
  obtain ⟨d₂, dp₂, hd₂⟩ := is_polytime_decode β,
  simp only [encode_nat_id] at hd₁ hd₂,
  obtain ⟨e₁, ep₁, he₁⟩ := is_polytime_encode α,
  obtain ⟨e₂, ep₂, he₂⟩ := is_polytime_encode β,
  use (code.ite (somec₁.comp $ d₁.comp code.fst) zero $
      code.ite (somec₂.comp $ d₂.comp code.snd) zero $
      (code.bit tt).comp (code.pair (tail.comp $ d₁.comp code.fst) (tail.comp $ d₂.comp code.snd))),
  split,
  { have P₁ : polytime (d₁.comp code.fst) := polytime_comp dp₁ polytime_fst,
    have P₂ : polytime (d₂.comp code.snd) := polytime_comp dp₂ polytime_snd,
    exact (
      polytime_ite (polytime_comp somep₁ P₁) polytime_zero $
      polytime_ite (polytime_comp somep₂ P₂) polytime_zero $
      (polytime_comp (polytime_bit _) (polytime_pair (polytime_comp polytime_tail P₁) (polytime_comp polytime_tail P₂)))), },
  intro x,
  cases H₁ : decode α (nat.unpair' x).1, { simp [H₁, hd₁, hsome₁], refl, },
  cases H₂ : decode β (nat.unpair' x).2, { simp [H₁, hd₁, hsome₁, H₂, hd₂, hsome₂], refl, },
  simp [H₁, hd₁, hsome₁, H₂, hd₂, hsome₂], simp [polycodable.encode, nat.bit],
end

lemma polytime_prod_fst (α β : Type) [polycodable α] [polycodable β] : is_polytime (@prod.fst α β) :=
⟨code.fst, polytime_fst, λ x, by simp [polycodable.encode]⟩

lemma polytime_prod_snd (α β : Type) [polycodable α] [polycodable β] : is_polytime (@prod.snd α β) :=
⟨code.snd, polytime_snd, λ x, by simp [polycodable.encode]⟩

lemma prod_encode_def (x : α × β) : (encode x.1).mkpair' (encode x.2) = encode x := rfl

lemma is_polytime_pair {f : α → β} {g : α → γ} : is_polytime f → is_polytime g → is_polytime (λ x, (f x, g x))
| ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ := ⟨code.pair fc gc, polytime_pair fp gp, λ x, by simp [hf, hg]⟩

def is_polytime₂ (f : α → β → γ) : Prop := is_polytime (function.uncurry f)

lemma is_polytime₂_comp {δ : Type} [polycodable δ] {f : α → β → γ} {g : δ → α} {h : δ → β}
  (hf : is_polytime₂ f) (hg : is_polytime g) (hh : is_polytime h) :
  is_polytime (λ x, f (g x) (h x)) :=
is_polytime_comp hf (is_polytime_pair hg hh)

@[simp] lemma function.uncurry_prod_mk (α β : Type*) : function.uncurry (@prod.mk α β) = id :=
by ext x; cases x; simp

lemma is_polytime₂_ignore_fst {f : α → β} (h : is_polytime f) : is_polytime₂ (λ x : γ, f) :=
by { have := is_polytime_comp h (polytime_prod_snd _ _), exact this, }

lemma is_polytime_prod_mk : is_polytime₂ (@prod.mk α β) := ⟨code.id, polytime_id, λ x, by simp⟩

end prod

section bool

lemma is_polytime_band : is_polytime₂ band :=
begin
  convert_to is_polytime₂ (λ b₁ b₂, cond b₁ b₂ ff),
  { ext b₁ b₂, cases b₁; cases b₂; refl, },
  apply is_polytime_cond,
  exacts [polytime_prod_fst _ _, polytime_prod_snd _ _, is_polytime_const _ _],
end

lemma is_polytime_bor : is_polytime₂ bor :=
begin
  convert_to is_polytime₂ (λ b₁ b₂, cond b₁ tt b₂), { ext b₁ b₂, cases b₁; cases b₂; refl, },
  apply is_polytime_cond,
  exacts [polytime_prod_fst _ _,  is_polytime_const _ _, polytime_prod_snd _ _],
end

end bool

section option

lemma is_polytime_elim {g : α → option β} {f : α → β → γ} {df : α → γ} :
  is_polytime g → is_polytime₂ f → is_polytime df → is_polytime (λ x, (g x).elim (df x) (f x))
| ⟨gc, gp, hg⟩ ⟨fc, fp, hf⟩ ⟨dfc, dfp, hdf⟩ :=
⟨code.ite gc dfc (fc.comp $ code.pair code.id (tail.comp gc)),
  polytime_ite gp dfp (polytime_comp fp $ polytime_pair polytime_id (polytime_comp polytime_tail gp)),
  λ x,
begin
  simp only [← prod_encode_def] at hf,
  cases e : g x with v, { simp [hg, hdf, e, encode], }, { simp [hg, hdf, e, encode, hf (x, v)], }
end⟩

lemma is_polytime_some : is_polytime (@some α) :=
⟨code.bit tt, polytime_bit _, by simp [encode, nat.bit]⟩

lemma is_polytime_of_is_polytime_some {f : α → β} (hf : is_polytime (some ∘ f)) : is_polytime f :=
by { rcases hf with ⟨c, pc, hc⟩, use [tail.comp c, polytime_comp polytime_tail pc], intro x, simp [hc x, encode], }

lemma is_polytime_bind_option {f : α → option β} {g : α → β → option γ} (hf : is_polytime f) (hg : is_polytime₂ g) :
  is_polytime (λ x, (f x).bind (g x)) :=
begin
  convert_to is_polytime (λ x, (f x).elim none (g x)), { ext x : 1, cases f x; simp, },
  exact is_polytime_elim hf hg (is_polytime_const _ none),
end

lemma is_polytime_map_option {f : α → option β} {g : α → β → γ} (hf : is_polytime f) (hg : is_polytime₂ g) :
  is_polytime (λ x, (f x).map (g x)) :=
begin
  change is_polytime (λ x, (f x).bind (some ∘ (g x))), -- turns out, defeq !
  exact is_polytime_bind_option hf (is_polytime_comp is_polytime_some hg),
end

end option

section embedding

def polycodable_of_embedding {β : Type} (e : β → α) (f : α → option β)
  (h : ∀ x, f (e x) = some x) (poly : is_polytime (λ x, (f x).map e)) : polycodable β :=
polycodable.mk'
(λ x, encode (e x))
(λ n, decode α n >>= f)
(λ x, by simp [h])
begin
  convert_to is_polytime (λ n, decode α n >>= (λ x, ((f x).map e).map encode)),
  { ext n : 1, cases decode α n; simp, },
  apply is_polytime_bind_option, { exact is_polytime_decode _, },
  apply is_polytime₂_ignore_fst, apply is_polytime_map_option poly,
  apply is_polytime₂_ignore_fst, apply is_polytime_encode,
end

lemma is_polytime_of_embedding_inclusion {β : Type} {e : β → α} {f : α → option β}
  {h : ∀ x, f (e x) = some x} {poly : is_polytime (λ x, (f x).map e)} :
  by { haveI := polycodable_of_embedding e f h poly, exact (is_polytime e), } :=
by { use [code.id, polytime_id], intro, simp, }

lemma is_polytime_of_embedding_inverse {β : Type} {e : β → α} {f : α → option β}
  {h : ∀ x, f (e x) = some x} {poly : is_polytime (λ x, (f x).map e)} :
  by { haveI := polycodable_of_embedding e f h poly, exact (is_polytime f), } :=
by { rcases poly with ⟨c, pc, hc⟩, use [c, pc], intro x, simp [hc x, encode], refl, }

end embedding

section subtype

def is_polytime_pred (p : α → Prop) [decidable_pred p] : Prop :=
is_polytime (λ x : α, (p x : bool))

lemma is_polytime_ite {p : α → Prop} [decidable_pred p] (hp : is_polytime_pred p) {f g : α → β}
  (hf : is_polytime f) (hg : is_polytime g) : is_polytime (λ x, if p x then f x else g x) :=
begin
  convert_to is_polytime (λ x, cond (p x) (f x) (g x)), { ext x, split_ifs with h; simp [h], },
  apply is_polytime_cond; assumption,
end

def polycodable_subtype {p : α → Prop} [decidable_pred p] (hp : is_polytime_pred p) :
  polycodable {x // p x} :=
polycodable_of_embedding
  (λ x, (x : α))
  (λ x, if h : p x then some ⟨x, h⟩ else none)
  (λ x, by simpa [imp_false] using subtype.prop x)
begin
  convert_to is_polytime (λ x, if p x then some x else none), { ext x : 1, split_ifs; simp, },
  exact is_polytime_ite hp is_polytime_some (is_polytime_const _ _),
end

end subtype

section sigma

private def sum_as_tuple : α ⊕ β → bool × ℕ
| (sum.inl a) := (ff, encode a)
| (sum.inr b) := (tt, encode b)

private def tuple_as_sum (n : bool × ℕ) : option (α ⊕ β) :=
cond n.1 ((decode β n.2).map sum.inr) ((decode α n.2).map sum.inl)

instance : polycodable (α ⊕ β) :=
polycodable_of_embedding sum_as_tuple tuple_as_sum
  (λ x, by cases x; simp [sum_as_tuple, tuple_as_sum])
begin
  convert_to is_polytime (λ n : bool × ℕ, cond n.1 ((decode β n.2).map (λ x, (tt, encode x)))
    ((decode α n.2).map (λ x, (ff, encode x)))),
  { ext n : 1, cases n with b v, cases b; simp [tuple_as_sum]; congr, },
  apply is_polytime_cond (polytime_prod_fst _ _),
  change is_polytime₂ (λ (b : bool) (n : ℕ), (decode β n).map (λ x, (tt, encode x))),
  { apply is_polytime₂_ignore_fst, apply is_polytime_map_option, apply is_polytime_decode,
    apply is_polytime₂_ignore_fst, apply is_polytime₂_comp is_polytime_prod_mk, apply is_polytime_const,
    apply is_polytime_encode, },
  change is_polytime₂ (λ (b : bool) (n : ℕ), (decode α n).map (λ x, (ff, encode x))),
  { apply is_polytime₂_ignore_fst, apply is_polytime_map_option, apply is_polytime_decode,
    apply is_polytime₂_ignore_fst, apply is_polytime₂_comp is_polytime_prod_mk, apply is_polytime_const,
    apply is_polytime_encode, },
end

private lemma is_polytime_sum_as_tuple : is_polytime (@sum_as_tuple α β _ _) := is_polytime_of_embedding_inclusion
private lemma is_polytime_tuple_as_sum : is_polytime (@tuple_as_sum α β _ _) := is_polytime_of_embedding_inverse

lemma is_polytime_sum_inl : is_polytime (@sum.inl α β) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ a : α, (tuple_as_sum (ff, encode a) : option (α ⊕ β)) ),
  { ext a : 1, simp [tuple_as_sum], },
  apply is_polytime_comp is_polytime_tuple_as_sum,
  apply is_polytime₂_comp is_polytime_prod_mk, { apply is_polytime_const, }, apply is_polytime_encode,
end

lemma is_polytime_sum_inr : is_polytime (@sum.inr α β) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ b : β, (tuple_as_sum (tt, encode b) : option (α ⊕ β)) ),
  { ext b : 1, simp [tuple_as_sum], },
  apply is_polytime_comp is_polytime_tuple_as_sum,
  apply is_polytime₂_comp is_polytime_prod_mk, { apply is_polytime_const, }, apply is_polytime_encode,
end

lemma is_polytime_sum_elim {δ : Type} [polycodable δ] {f : δ → α → γ} (g : δ → β → γ) {h : δ → α ⊕ β }
  (hf : is_polytime₂ f) (hg : is_polytime₂ g) (hh : is_polytime h) :
  is_polytime (λ x, (h x).elim (f x) (g x)) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ x : δ, cond (sum_as_tuple $ h x).1 ((decode β $ (sum_as_tuple $ h x).2).map (g x))
    ((decode α $ (sum_as_tuple $ h x).2).map (f x))),
  { ext x : 1, simp only [function.comp_app], cases h x; simp [sum_as_tuple], },
  apply is_polytime_cond, { apply is_polytime_comp (polytime_prod_fst _ _), apply is_polytime_comp is_polytime_sum_as_tuple hh, },
  { apply is_polytime_map_option, apply is_polytime_comp (is_polytime_decode _), apply is_polytime_comp (polytime_prod_snd _ _),
    apply is_polytime_comp is_polytime_sum_as_tuple hh, exact hg, },
  apply is_polytime_map_option, apply is_polytime_comp (is_polytime_decode _), apply is_polytime_comp (polytime_prod_snd _ _),
  apply is_polytime_comp is_polytime_sum_as_tuple hh, exact hf,
end

end sigma

section list

def mklist (ls : list ℕ) : ℕ := ls.foldr nat.mkpair' 0
def unlist : ℕ → list ℕ
| 0 := []
| (nat.succ n) := have wf : (nat.unpair' n.succ).2 < n.succ := nat.unpair'_snd_lt n,
              (nat.unpair' n.succ).1 :: (unlist (nat.unpair' n.succ).2)

@[simp] lemma unlist_mklist (ls : list ℕ) : unlist (mklist ls) = ls :=
begin
  induction ls with h t ih, { simp [mklist, unlist], },
  simp only [mklist, list.foldr],
  cases e : nat.mkpair' h _, { cases nat.mkpair'_ne_zero _ _ e, },
  simp only [unlist], rw ← e,
  split; simp, exact ih,
end

section recursion

end recursion

end list


/-
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

end Mathlib


import tactic
import measure_theory.interval_integral
import measure_theory.lebesgue_measure
import measure_theory.set_integral
import analysis.calculus.deriv
import analysis.special_functions.exp_log
import analysis.special_functions.trigonometric
import data.finset

noncomputable theory
open_locale classical
open_locale big_operators
open measure_theory
open interval_integral
open set
open real

namespace tactic.interactive

meta def show_continuous := `[
  all_goals {try {simp}},
  apply_rules [
    continuous_on.neg,
    continuous.continuous_on,
    differentiable.continuous,
    differentiable_on.continuous_on,
    continuous.Icc_extend,
    continuous_on.mono,
    continuous.neg,
    continuous_id,
    continuous_sin,
    continuous_cos,
    continuous_const,
    continuous.pow,
    continuous.mul,
    continuous.smul,
    continuous.sub,
    continuous.add
    ] 10,
  all_goals {try {norm_num}}
]

meta def show_differentiable := `[
  apply_rules [
    differentiable.differentiable_on,
    differentiable.neg,
    differentiable.smul,
    differentiable.cos,
    differentiable.sin,
    differentiable_const,
    differentiable_id,
    differentiable.mul,
    differentiable_fpow
    ] 10,
  all_goals {try {norm_num}}
]

meta def show_nonzero := `[
  apply_rules [
    mul_ne_zero,
    sub_ne_zero_of_ne,
    pow_ne_zero,
    ne_of_gt,
    ne_of_lt
    ] 10,
  all_goals {try {norm_cast}, try {norm_num}}
]

meta def show_pos := `[
  apply_rules [
    nat.succ_pos,
    mul_pos,
    div_pos,
    inv_pos.mpr,
    pow_pos
    ] 10,
  all_goals {try {norm_cast}, try {norm_num}, try {nlinarith}}
]

meta def clear_denoms := `[
  try {rw div_eq_div_iff},
  try {rw eq_div_iff},
  try {symmetry, rw eq_div_iff},
  try { ring_exp },
  all_goals {show_nonzero}
]

meta def discrete_field := `[
  try {ext},
  try {field_simp *},
  try {clear_denoms},
  try {ring_exp},
  try {norm_num},
  try {linarith}
]

end tactic.interactive

lemma integrable_of_cont {f : ℝ → ℝ} (a b : ℝ) (h : continuous f):
    interval_integrable f measure_theory.measure_space.volume a b :=
begin
    have hmeas : measurable f := continuous.measurable h,
    have hconton : continuous_on f (interval a b) := continuous.continuous_on h,
    exact continuous_on.interval_integrable hconton,
end

/- lemma self_mem_ae_restrict
  {s : set ℝ} (hs : is_measurable s):
  s ∈ (measure.restrict measure_space.volume s).ae :=
begin
  rw ae_restrict_eq hs,
  simp only [exists_prop, filter.mem_principal_sets, filter.mem_inf_sets],
  exact ⟨univ, filter.univ_mem_sets, s, by simp⟩,
end
 -/
lemma nonempty_inter_of_nonempty_inter_closure {α : Type*} [topological_space α] {s t : set α}
  (hs : is_open s) (h : (s ∩ closure t).nonempty) : (s ∩ t).nonempty :=
let ⟨x, xs, xt⟩ := h in _root_.mem_closure_iff.1 xt s hs xs

lemma real.volume_pos_of_is_open_of_nonempty {s : set ℝ} (h : is_open s) (h' : s.nonempty) :
  0 < volume s :=
begin
  rcases h' with ⟨x, hx⟩,
  have : ∀ᶠ (y : ℝ) in nhds x, y ∈ s := filter.eventually_of_mem (mem_nhds_sets h hx) (λ y H, H),
  exact filter.eventually.volume_pos_of_nhds_real this,
end

theorem integral_strictly_pos_of_cont (f : ℝ → ℝ) (a b : ℝ)
    (hf : continuous f)
    (hab : a < b)
    (h : ∀ (x : ℝ), a ≤ x → x ≤ b → 0 ≤ f x)
    (hneq: ∃ x, a ≤ x ∧ x ≤ b ∧ 0 < f x) :
    0 < ∫ x in a..b, f x :=
begin
  rw integral_pos_iff_support_of_nonneg_ae',
  { refine ⟨hab, _⟩,
    let s := {b : ℝ | 0 < f b},
    have s_open : is_open s := is_open_lt continuous_const hf,
    have : (s ∩ closure (Ioo a b)).nonempty,
    { rw closure_Ioo hab,
      rcases hneq with ⟨x, ax, xb, fxpos⟩,
      have : x ∈ s ∩ Icc a b := ⟨fxpos, ax, xb⟩,
      exact nonempty_of_mem this },
    have : (s ∩ Ioo a b).nonempty := nonempty_inter_of_nonempty_inter_closure s_open this,
    have : 0 < volume (s ∩ Ioo a b) :=
      real.volume_pos_of_is_open_of_nonempty (is_open_inter s_open is_open_Ioo) this,
    refine this.trans_le (measure_mono (λ x hx, _)),
    split,
    { exact ne_of_gt (show 0 < f x, from hx.1) },
    { exact ⟨hx.2.1, hx.2.2.le⟩ } },
  { have : Ioc b a = ∅ := Ioc_eq_empty hab.le,
    simp only [this, union_empty],
    apply filter.eventually_of_mem _ _,
    exact Icc a b,
    {
        simp,
        use univ,
        simp,
        use Icc a b,
        exact ⟨Ioc_subset_Icc_self, rfl.subset⟩,
    },
    simpa using h },
  { exact integrable_of_cont a b hf }
end

theorem integral_strictly_monotone_of_cont (f g : ℝ → ℝ) (a b : ℝ)
    (hf : continuous f) (hg : continuous g) (hab : a < b)
    (h : ∀ (x : ℝ), a ≤ x → x ≤ b → f x ≤ g x)
    (hneq: ∃ x, a ≤ x ∧ x ≤ b ∧ f x < g x) :
    ∫ x in a..b, f x < ∫ x in a..b, g x :=
begin
    have H : 0 < ∫ x in a..b, (g x - f x),
    {
        apply integral_strictly_pos_of_cont
        (g-f) a b (continuous.sub hg hf) hab,
        all_goals {
            simp [sub_pos],
            assumption,
        },
    },
    rw [←sub_pos, ←interval_integral.integral_sub (integrable_of_cont a b hg) (integrable_of_cont a b hf)],
    exact H,
end

lemma int_pos_of_pos {f : ℝ → ℝ} {a b : ℝ} (hab : a < b) (hf : continuous f)
(hnonneg : ∀ x, a ≤ x → x ≤ b → 0 ≤ f x)
(hx : ∃ x, a ≤ x ∧ x ≤ b ∧ 0 < f x) : 0 < ∫ x in a..b, f x :=
begin
    rw ← (integral_zero : ∫ x in a..b, (0:ℝ) = 0 ),
    exact integral_strictly_monotone_of_cont (λ x, (0:ℝ)) f a b continuous_const hf hab hnonneg hx,
end

lemma int_pos_of_square {f : ℝ → ℝ} {a b} (x : ℝ)
    (hab : a < b) (hf : continuous f) (hx : a ≤ x ∧ x ≤ b ∧ f x ≠ 0) :
     0 < ∫ x in a..b, (f x)^2 :=
begin
    refine int_pos_of_pos hab _
        (λ x hx1 hx2, pow_two_nonneg (f x)) ⟨x, ⟨hx.1, hx.2.1, pow_two_pos_of_ne_zero (f x) hx.2.2⟩⟩,
    show_continuous,
end

theorem my_integral_smul (f : ℝ → ℝ) (a b c : ℝ) :
    ∫ x in a..b, c * (f x) = c * ∫ x in a..b, f x :=
begin
    suffices :  ∫ x in a..b, c • (f x) = c • ∫ x in a..b, f x, by exact this,
    rw_mod_cast interval_integral.integral_smul,
end

theorem product_rule {f g : ℝ → ℝ} (hdf : differentiable ℝ f) (hdg : differentiable ℝ g) :
    deriv (f * g) = (deriv f) * g + f * deriv g :=
begin
    ext,
    have hdf0 : differentiable_at ℝ f x := hdf x,
    have hdg0 : differentiable_at ℝ g x := hdg x,
    apply deriv_mul hdf0 hdg0,
end

theorem differentiable_fpow {f : ℝ → ℝ} {n : ℕ} :
    differentiable ℝ f → differentiable ℝ (f^n) :=
begin
    induction n with d hd,
    { intro h,
      simp only [pow_zero],
        exact differentiable_const 1 },
    {
        intro h,
        rw pow_succ,
        exact h.mul (hd h),
    }
end

theorem power_rule {f : ℝ → ℝ} {n : ℕ} (hfd : differentiable ℝ f):
    deriv (f^(n+1)) = ((n : ℝ) + 1) • f^n * (deriv f) :=
begin
    induction n with d hd, by norm_num,
    have H : f^(d+1) = f^d * f := pow_succ' f d,
    calc
        deriv (f^(d.succ+1)) = deriv (f^(d.succ) * f) : by {rw pow_succ' f (d.succ),}
        ... = (deriv (f^(d.succ))) * f + f^(d+1) * (deriv f) :
        begin
            rw product_rule,
            exact differentiable_fpow hfd,
            exact hfd,
        end
        ... = ((d:ℝ) + 1) • f^d * deriv f * f + f^d.succ * deriv f : by {rw hd}
        ... = ((d:ℝ) + 1) • (f^(d.succ)) * deriv f + f^(d.succ) * deriv f :
        begin
            simp only [add_left_inj, H],
            norm_num,
            rw mul_assoc,
            nth_rewrite_lhs 1 mul_comm,
            rw ←mul_assoc,
        end
        ... = ((d.succ:ℝ) + 1) • (f^(d.succ)) * deriv f :
        begin
            simp only [nat.cast_succ, algebra.smul_mul_assoc],
            nth_rewrite 1 add_smul,
            rw one_smul,
        end
end

lemma pow_fun_def {f : ℝ → ℝ} {n : ℕ} : f^n = λ x, (f x)^n :=
begin
    induction n with d hd,
    all_goals {
        try {rw [pow_succ, hd]},
        refl,
    }
end

lemma pow_deriv_fun_def {f : ℝ → ℝ} {n : ℕ} : ((n : ℝ) + 1) • f^n * (deriv f) =
    λ (x : ℝ), ((n : ℝ) + 1) • ((f x)^n * deriv f x) :=
begin
    rw pow_fun_def,
    simpa,
end

@[simp] lemma power_rule'  {f : ℝ → ℝ} (n : ℕ) (hfd : differentiable ℝ f):
    deriv (λ (x : ℝ), (f x)^(n + 1)) = λ (x : ℝ), ((n : ℝ) + 1) • ((f x)^n * deriv f x) :=
begin
    rw [←pow_fun_def, ←pow_deriv_fun_def],
    exact power_rule hfd,
end

@[simp] lemma power_rule'' (n : ℕ) :
    deriv (λ (x : ℝ), x^(n + 1)) = λ (x : ℝ), ((n : ℝ) + 1) • (x^n) :=
begin
    have hfd : differentiable ℝ (λ (x:ℝ), (x:ℝ)) := differentiable_id',
    have deriv_id_my : deriv (λ x, x) = λ (x : ℝ), (1:ℝ) := deriv_id',
    have H := power_rule' n hfd,
    rw deriv_id_my at H,
    rw H,
    simp only [mul_one, algebra.id.smul_eq_mul],
end

theorem int_by_parts (u v : ℝ → ℝ) {a b : ℝ} (hu : differentiable ℝ u)
    (hv : differentiable ℝ v) (hcu : continuous(deriv u)) (hcv : continuous(deriv v)) :
∫ x in a..b, u x * deriv v x =
    u b * v b - u a * v a - ∫ x in a..b,  v x * deriv u x :=
begin
    have hu' : ∀ (x : ℝ), differentiable_at ℝ u x := hu,
    have hv' : ∀ (x : ℝ), differentiable_at ℝ v x := hv,
    have huv : deriv (u * v) = (deriv u) * v + u * deriv v := product_rule hu hv,
    have H : ∫ x in  a..b, ((deriv u) x) * (v x)  + (u x) * ((deriv v) x) = ∫ x in a..b, (deriv (u*v)) x,
    {
        congr,
        solve_by_elim,
    },
    have duv_cont : continuous (deriv (u * v)),
    {
        rw product_rule hu hv,
        apply continuous.add,
        rw mul_comm,
        all_goals {
            apply continuous.mul,
            work_on_goal 0
            {
                apply @differentiable.continuous ℝ _ _ _ _ _ _ _,
            },
            repeat {assumption},
        },
    },
    have duv_cont' : continuous_on (deriv (u * v)) (interval a b),
    {
        intros x hx,
        exact continuous.continuous_within_at duv_cont,
    },
    have H2 : ∫ x in a..b, deriv (u*v) x = u b * v b - u a * v a,
    {
        apply integral_deriv_eq_sub,
        intros x hx,
        exact differentiable_at.mul (hu' x) (hv' x),
        exact duv_cont',
    },
    rw [←H2, ←interval_integral.integral_sub],
    {
        congr,
        ext,
        rw huv,
        simp only [pi.add_apply, pi.mul_apply],
        rw mul_comm (v x) (deriv u x),
        ring,
    },
    {
        apply integrable_of_cont,
        assumption,
    },
    apply integrable_of_cont,
    apply continuous.mul,
    apply @differentiable.continuous ℝ _ _ _ _ _ _ _,
    repeat {assumption},
end

lemma int_by_parts_zero_ends (u v : ℝ → ℝ) {a b : ℝ} (hu : differentiable ℝ u)
    (hv : differentiable ℝ v) (hcu : continuous(deriv u)) (hcv : continuous(deriv v))
    (ha : u a * v a = 0) (hb : u b * v b = 0)
    :
∫ x in a..b, u x * deriv v x = - ∫ x in a..b,  v x * deriv u x :=
begin
    rw int_by_parts,
    repeat {assumption},
    rw [ha, hb],
    norm_num,
end

@[simp] lemma pow_ext (f : ℝ → ℝ) (n : ℕ) : f^n = λ x, (f x)^n :=
begin
    induction n with d hd,
    {
        norm_num,
        refl,
    },
    {
        change f^(d+1) = λ x, (f x)^(d+1),
        rw [pow_add, hd, pow_one],
        ext,
        norm_num,
        ring_nf,
    }
end

lemma differentiable_cospow_at (n: ℕ) {x : ℝ} : differentiable_at ℝ (cos^(n+1)) x:=
by show_differentiable

lemma deriv_cospow (n: ℕ) : deriv (λ (x : ℝ), cos x ^ (n+1)) = λ x, -((n : ℝ)+1) * (cos x)^n * sin x :=
begin
    suffices : (λ (x : ℝ), -(((n:ℝ) + 1) * (cos x ^ n * sin x))) =
        λ (x : ℝ), (-1 + -n) * cos x^n * sin x, by simpa,
    ext,
    ring,
end

lemma continuous_cospow {n: ℕ} : continuous (λ (x : ℝ), (cos x)^n) :=
begin
    exact continuous.pow continuous_cos n,
end

lemma continuous_cospow' {c : ℝ} {m : ℕ}  :
  continuous
    (λ (x : ℝ), c * cos x ^m) := by show_continuous

lemma differentiable_cospow {n: ℕ} : differentiable ℝ (λ (x : ℝ), (cos x)^n) :=
begin
    simp only [differentiable_id', differentiable.pow, differentiable.cos],
end

lemma continuous_deriv_cospow (n: ℕ) : continuous (deriv (λ (x : ℝ), cos x ^ (n+1))) :=
begin
    rw deriv_cospow,
    apply continuous.mul continuous_cospow' continuous_sin,
end

@[simp] lemma deriv_sin_times_cos {x : ℝ} : deriv(sin * cos) x =
    2 * cos x ^ 2 - 1 :=
begin
    have H : deriv (λ (y : ℝ), sin y * cos y) x =
        deriv sin x * cos x + sin x * deriv cos x
        := deriv_mul differentiable_at_sin differentiable_at_cos,
    have h0 : sin * cos = λ y, sin y * cos y, by refl,
    have hsin : sin x^2 = 1 - cos x^2,
    {
        rw eq_sub_iff_add_eq,
        exact sin_sq_add_cos_sq x,
    },
    rw [h0, H, real.deriv_sin, real.deriv_cos],
    ring_nf,
    rw hsin,
    ring,
end

@[simp] lemma deriv_sin_cos {m : ℕ} : deriv (λ x, sin x * cos x^(m+1)) =
    λ x, (m+2) * cos x^(m+2) - (m+1) * cos x^m :=
begin
    ext,
    suffices : deriv(sin * cos^(m+1)) x =
    (m+2) * (cos x)^(m+2) - (m+1) * (cos x)^m,
    {
        rw pow_ext at this,
        exact this,
    },
    induction m with d hd,
    {
        simp only [mul_one, nat.cast_zero, pow_one, zero_add, pow_zero],
        exact deriv_sin_times_cos,
    },
    {
        simp,
        have H := deriv_mul (@differentiable_at_sin x)
            (differentiable_cospow_at d.succ),
        repeat {rw pow_succ,},
        have h2 : (λ (y : ℝ), sin y * (cos ^ (d.succ + 1)) y) x =
            sin x * (cos ^ (d.succ + 1)) x, by tauto,
        have hsin : sin * (λ (x : ℝ), cos x ^ (d.succ + 1)) =
            (λ x, sin x * cos x ^ (d.succ + 1)), by tauto,
        rw hsin,
        have hhd : (sin * cos ^ (d + 1) = λ (y : ℝ), sin y * cos y ^ (d + 1)),
        {
            ext,
            simp only [pi.mul_apply, pow_ext],
        },
        simp [pow_ext],
        ring_exp,
        have sin_to_cos : sin x^2 = 1 - cos x^2,
        {
            rw eq_sub_iff_add_eq,
            exact sin_sq_add_cos_sq x,
        },
        rw sin_to_cos,
        discrete_field,
    },
end


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.kernel_pair
import category_theory.limits.shapes.comm_sq

/-!
# The diagonal object of a morphism.

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

We provide various API and isomorphisms considering the diagonal object `Δ_{Y/X} := pullback f f`
of a morphism `f : X ⟶ Y`.

-/

open category_theory

noncomputable theory

namespace category_theory.limits

variables {C : Type*} [category C] {X Y Z : C}

namespace pullback

section diagonal

variables (f : X ⟶ Y) [has_pullback f f]

/-- The diagonal object of a morphism `f : X ⟶ Y` is `Δ_{X/Y} := pullback f f`. -/
abbreviation diagonal_obj : C := pullback f f

/-- The diagonal morphism `X ⟶ Δ_{X/Y}` for a morphism `f : X ⟶ Y`. -/
def diagonal : X ⟶ diagonal_obj f :=
pullback.lift (𝟙 _) (𝟙 _) rfl

@[simp, reassoc] lemma diagonal_fst : diagonal f ≫ pullback.fst = 𝟙 _ :=
pullback.lift_fst _ _ _

@[simp, reassoc] lemma diagonal_snd : diagonal f ≫ pullback.snd = 𝟙 _ :=
pullback.lift_snd _ _ _

instance : is_split_mono (diagonal f) :=
⟨⟨⟨pullback.fst, diagonal_fst f⟩⟩⟩

instance : is_split_epi (pullback.fst : pullback f f ⟶ X) :=
⟨⟨⟨diagonal f, diagonal_fst f⟩⟩⟩

instance : is_split_epi (pullback.snd : pullback f f ⟶ X) :=
⟨⟨⟨diagonal f, diagonal_snd f⟩⟩⟩

instance [mono f] : is_iso (diagonal f) :=
begin
  rw (is_iso.inv_eq_of_inv_hom_id (diagonal_fst f)).symm,
  apply_instance
end

/-- The two projections `Δ_{X/Y} ⟶ X` form a kernel pair for `f : X ⟶ Y`. -/
lemma diagonal_is_kernel_pair :
  is_kernel_pair f (pullback.fst : diagonal_obj f ⟶ _) pullback.snd :=
is_pullback.of_has_pullback f f

end diagonal

end pullback

variable [has_pullbacks C]

open pullback

section

variables {U V₁ V₂ : C} (f : X ⟶ Y) (i : U ⟶ Y)
variables (i₁ : V₁ ⟶ pullback f i) (i₂ : V₂ ⟶ pullback f i)

@[simp, reassoc]
lemma pullback_diagonal_map_snd_fst_fst :
  (pullback.snd : pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i
    (by simp [condition]) (by simp [condition])) ⟶ _) ≫ fst ≫ i₁ ≫ fst = pullback.fst :=
begin
  conv_rhs { rw ← category.comp_id pullback.fst },
  rw [← diagonal_fst f, pullback.condition_assoc, pullback.lift_fst]
end

@[simp, reassoc]
lemma pullback_diagonal_map_snd_snd_fst :
  (pullback.snd : pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i
    (by simp [condition]) (by simp [condition])) ⟶ _) ≫ snd ≫ i₂ ≫ fst = pullback.fst :=
begin
  conv_rhs { rw ← category.comp_id pullback.fst },
  rw [← diagonal_snd f, pullback.condition_assoc, pullback.lift_snd]
end

variable [has_pullback i₁ i₂]

/--
This iso witnesses the fact that
given `f : X ⟶ Y`, `i : U ⟶ Y`, and `i₁ : V₁ ⟶ X ×[Y] U`, `i₂ : V₂ ⟶ X ×[Y] U`, the diagram

V₁ ×[X ×[Y] U] V₂ ⟶ V₁ ×[U] V₂
        |                 |
        |                 |
        ↓                 ↓
        X         ⟶  X ×[Y] X

is a pullback square.
Also see `pullback_fst_map_snd_is_pullback`.
-/
def pullback_diagonal_map_iso :
  pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i
    (by simp [condition]) (by simp [condition])) ≅ pullback i₁ i₂ :=
{ hom := pullback.lift (pullback.snd ≫ pullback.fst) (pullback.snd ≫ pullback.snd)
    begin
      ext; simp only [category.assoc, pullback.condition, pullback_diagonal_map_snd_fst_fst,
        pullback_diagonal_map_snd_snd_fst],
    end,
  inv := pullback.lift (pullback.fst ≫ i₁ ≫ pullback.fst) (pullback.map _ _ _ _ (𝟙 _) (𝟙 _)
      pullback.snd (category.id_comp _).symm (category.id_comp _).symm)
    begin
      ext; simp only [diagonal_fst, diagonal_snd, category.comp_id, pullback.condition_assoc,
        category.assoc, lift_fst, lift_fst_assoc, lift_snd, lift_snd_assoc],
    end,
  hom_inv_id' := by ext; simp only [category.id_comp, category.assoc, lift_fst_assoc,
    pullback_diagonal_map_snd_fst_fst, lift_fst, lift_snd, category.comp_id],
  inv_hom_id' := by ext; simp }

@[simp, reassoc]
lemma pullback_diagonal_map_iso_hom_fst :
  (pullback_diagonal_map_iso f i i₁ i₂).hom ≫ pullback.fst = pullback.snd ≫ pullback.fst :=
by { delta pullback_diagonal_map_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_iso_hom_snd :
  (pullback_diagonal_map_iso f i i₁ i₂).hom ≫ pullback.snd = pullback.snd ≫ pullback.snd :=
by { delta pullback_diagonal_map_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_iso_inv_fst :
  (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.fst = pullback.fst ≫ i₁ ≫ pullback.fst :=
by { delta pullback_diagonal_map_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_iso_inv_snd_fst :
  (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.snd ≫ pullback.fst = pullback.fst :=
by { delta pullback_diagonal_map_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_iso_inv_snd_snd :
  (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.snd ≫ pullback.snd = pullback.snd :=
by { delta pullback_diagonal_map_iso, simp }

lemma pullback_fst_map_snd_is_pullback :
  is_pullback
    (fst ≫ i₁ ≫ fst)
    (map i₁ i₂ (i₁ ≫ snd) (i₂ ≫ snd) _ _ _ (category.id_comp _).symm (category.id_comp _).symm)
    (diagonal f)
    (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i
      (by simp [condition]) (by simp [condition])) :=
is_pullback.of_iso_pullback ⟨by ext; simp [condition_assoc]⟩
  (pullback_diagonal_map_iso f i i₁ i₂).symm (pullback_diagonal_map_iso_inv_fst f i i₁ i₂)
  (by ext1; simp)

end

section

variables {S T : C} (f : X ⟶ T) (g : Y ⟶ T) (i : T ⟶ S)
variables [has_pullback i i] [has_pullback f g] [has_pullback (f ≫ i) (g ≫ i)]
variable [has_pullback (diagonal i) (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _)
    (category.comp_id _) (category.comp_id _))]

/--
This iso witnesses the fact that
given `f : X ⟶ T`, `g : Y ⟶ T`, and `i : T ⟶ S`, the diagram

X ×ₜ Y ⟶ X ×ₛ Y
   |         |
   |         |
   ↓         ↓
   T   ⟶ T ×ₛ T

is a pullback square.
Also see `pullback_map_diagonal_is_pullback`.
-/
def pullback_diagonal_map_id_iso :
  pullback (diagonal i) (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _)
    (category.comp_id _) (category.comp_id _)) ≅ pullback f g :=
begin
  refine (as_iso $ pullback.map _ _ _ _ (𝟙 _) (pullback.congr_hom _ _).hom (𝟙 _) _ _) ≪≫
    pullback_diagonal_map_iso i (𝟙 _) (f ≫ inv pullback.fst) (g ≫ inv pullback.fst) ≪≫
      (as_iso $ pullback.map _ _ _ _ (𝟙 _) (𝟙 _) pullback.fst _ _),
  { rw [← category.comp_id pullback.snd, ← condition, category.assoc, is_iso.inv_hom_id_assoc] },
  { rw [← category.comp_id pullback.snd, ← condition, category.assoc, is_iso.inv_hom_id_assoc] },
  { rw [category.comp_id, category.id_comp] },
  { ext; simp },
  { apply_instance },
  { rw [category.assoc, category.id_comp, is_iso.inv_hom_id, category.comp_id] },
  { rw [category.assoc, category.id_comp, is_iso.inv_hom_id, category.comp_id] },
  { apply_instance },
end

@[simp, reassoc]
lemma pullback_diagonal_map_id_iso_hom_fst :
  (pullback_diagonal_map_id_iso f g i).hom ≫ pullback.fst = pullback.snd ≫ pullback.fst :=
by { delta pullback_diagonal_map_id_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_id_iso_hom_snd :
  (pullback_diagonal_map_id_iso f g i).hom ≫ pullback.snd = pullback.snd ≫ pullback.snd :=
by { delta pullback_diagonal_map_id_iso, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_id_iso_inv_fst :
  (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.fst = pullback.fst ≫ f :=
begin
  rw [iso.inv_comp_eq, ← category.comp_id pullback.fst, ← diagonal_fst i, pullback.condition_assoc],
  simp,
end

@[simp, reassoc]
lemma pullback_diagonal_map_id_iso_inv_snd_fst :
  (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.snd ≫ pullback.fst = pullback.fst :=
by { rw iso.inv_comp_eq, simp }

@[simp, reassoc]
lemma pullback_diagonal_map_id_iso_inv_snd_snd :
  (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.snd ≫ pullback.snd = pullback.snd :=
by { rw iso.inv_comp_eq, simp }

lemma pullback.diagonal_comp (f : X ⟶ Y) (g : Y ⟶ Z) [has_pullback f f] [has_pullback g g]
  [has_pullback (f ≫ g) (f ≫ g)] :
  diagonal (f ≫ g) = diagonal f ≫ (pullback_diagonal_map_id_iso f f g).inv ≫ pullback.snd :=
by ext; simp

lemma pullback_map_diagonal_is_pullback : is_pullback (pullback.fst ≫ f)
  (pullback.map f g (f ≫ i) (g ≫ i) _ _ i (category.id_comp _).symm (category.id_comp _).symm)
  (diagonal i)
  (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _) (category.comp_id _) (category.comp_id _)) :=
begin
  apply is_pullback.of_iso_pullback _ (pullback_diagonal_map_id_iso f g i).symm,
  { simp },
  { ext; simp },
  { constructor, ext; simp [condition] },
end

/-- The diagonal object of `X ×[Z] Y ⟶ X` is isomorphic to `Δ_{Y/Z} ×[Z] X`. -/
def diagonal_obj_pullback_fst_iso {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
  diagonal_obj (pullback.fst : pullback f g ⟶ X) ≅
    pullback (pullback.snd ≫ g : diagonal_obj g ⟶ Z) f :=
pullback_right_pullback_fst_iso _ _ _ ≪≫ pullback.congr_hom pullback.condition rfl ≪≫
  pullback_assoc _ _ _ _ ≪≫ pullback_symmetry _ _ ≪≫ pullback.congr_hom pullback.condition rfl

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_fst_fst {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.fst ≫ pullback.fst =
    pullback.fst ≫ pullback.snd :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_fst_snd {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.fst ≫ pullback.snd =
    pullback.snd ≫ pullback.snd :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_snd {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.snd = pullback.fst ≫ pullback.fst :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_fst_fst {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.fst ≫ pullback.fst =
    pullback.snd :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_fst_snd {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.fst ≫ pullback.snd =
    pullback.fst ≫ pullback.fst :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_snd_fst {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) :
  (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.snd ≫ pullback.fst = pullback.snd :=
by { delta diagonal_obj_pullback_fst_iso, simp }

@[simp, reassoc]

lemma diagonal_pullback_fst {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
  diagonal (pullback.fst : pullback f g ⟶ _) =
    (pullback_symmetry _ _).hom ≫ ((base_change f).map
      (over.hom_mk (diagonal g) (by simp) : over.mk g ⟶ over.mk (pullback.snd ≫ g))).left ≫
    (diagonal_obj_pullback_fst_iso f g).inv :=
by ext; simp

end

/--
Given the following diagram with `S ⟶ S'` a monomorphism,

    X  ⟶ X'
      ↘      ↘
        S  ⟶ S'
      ↗      ↗
    Y  ⟶ Y'

This iso witnesses the fact that

      X ×[S] Y ⟶ (X' ×[S'] Y') ×[Y'] Y
          |                  |
          |                  |
          ↓                  ↓
(X' ×[S'] Y') ×[X'] X ⟶ X' ×[S'] Y'

is a pullback square. The diagonal map of this square is `pullback.map`.
Also see `pullback_lift_map_is_pullback`.
-/
@[simps]
def pullback_fst_fst_iso {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S')
  (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f')
  (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] :
    pullback (pullback.fst : pullback (pullback.fst : pullback f' g' ⟶ _) i₁ ⟶ _)
      (pullback.fst : pullback (pullback.snd : pullback f' g' ⟶ _) i₂ ⟶ _) ≅ pullback f g :=
{ hom := pullback.lift (pullback.fst ≫ pullback.snd) (pullback.snd ≫ pullback.snd)
    begin
      rw [← cancel_mono i₃, category.assoc, category.assoc, category.assoc, category.assoc, e₁, e₂,
        ← pullback.condition_assoc, pullback.condition_assoc, pullback.condition,
        pullback.condition_assoc]
    end,
  inv := pullback.lift
    (pullback.lift (pullback.map _ _ _ _ _ _ _ e₁ e₂) pullback.fst (pullback.lift_fst _ _ _))
    (pullback.lift (pullback.map _ _ _ _ _ _ _ e₁ e₂) pullback.snd (pullback.lift_snd _ _ _))
    begin
      rw [pullback.lift_fst, pullback.lift_fst]
    end,
  hom_inv_id' := by ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd,
    lift_fst_assoc, lift_snd_assoc, condition, ← condition_assoc],
  inv_hom_id' := by ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd,
    lift_fst_assoc, lift_snd_assoc], }

lemma pullback_map_eq_pullback_fst_fst_iso_inv {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S)
  (f' : X' ⟶ S')
  (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f')
  (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] :
  pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂ =
    (pullback_fst_fst_iso f g f' g' i₁ i₂ i₃ e₁ e₂).inv ≫ pullback.snd ≫ pullback.fst :=
begin
  ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd, lift_fst_assoc,
    lift_snd_assoc, pullback_fst_fst_iso_inv, ← pullback.condition, ← pullback.condition_assoc],
end

lemma pullback_lift_map_is_pullback {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S')
  (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f')
  (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] :
  is_pullback
    (pullback.lift (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂) fst (lift_fst _ _ _))
    (pullback.lift (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂) snd (lift_snd _ _ _))
    pullback.fst pullback.fst :=
is_pullback.of_iso_pullback ⟨by rw [lift_fst, lift_fst]⟩
  (pullback_fst_fst_iso f g f' g' i₁ i₂ i₃ e₁ e₂).symm (by simp) (by simp)

end category_theory.limits