import data.int.parity
import syntax
import deduction
open classical

universe variables u

structure kripke_frame (W : Type u) :=
(relation : W → W → Prop)

inductive singleton : Type u
| s : singleton

def trivial_frame : kripke_frame singleton := ⟨λ x y, true⟩

namespace rel

variable {W : Type u}
variable F :  kripke_frame W

def reflective := ∀ x, F.relation x x
def transitive := ∀ x y z, F.relation x y → F.relation y z → F.relation x z
def infinite_ascent := ∃ (z : ℕ → W), ∀ (n : ℕ), F.relation (z n) (z (n + 1))

end rel

def satisfy {W : Type u} (F : kripke_frame W) (V : ℕ → set W) : W → formula → Prop
| w (p : ℕ)   := w ∈ V p
| w ⊥ₘ        := false
| w (p →ₘ q) := satisfy w p → satisfy w q
| w □p       := ∀ v, F.relation w v → satisfy v p

def frames {W : Type u} (F : kripke_frame W) (p : formula) := ∀ V w, satisfy F V w p

notation `[`F`, `V`, `w`]` ` ⊧ `p := satisfy F V w p
infix ` ⊧ `:50 := frames

namespace semantics

variable {W : Type u}
variable F : kripke_frame W
variables p q : ℕ
variables φ ψ χ : formula
local infix ` ≺ `:50 := F.relation

theorem distribution : F ⊧ □(φ →ₘ ψ) →ₘ □φ →ₘ □ψ :=
λ (V : ℕ → set W)
  (w : W)
  (h₀ : [F, V, w] ⊧ □(φ →ₘ ψ))
  (h₁ : [F, V, w] ⊧ □φ)
  (v : W)
  (h₂ : w ≺ v),
h₀ v h₂ (h₁ v h₂)

theorem necessitation : F ⊧ φ → F ⊧ □φ :=
λ (h₀ : F ⊧ φ)
  (V : ℕ → set W)
  (w : W)
  (v : W)
  (h₁ : w ≺ v),
h₀ V v

/--
theorem trans_iff_4
  : rel.transitive F ↔ F ⊧ □p →ₘ □□p :=
begin
  split,
  { intros trans h₀ v h₁ u₀ r₀ u₁ r₁,
    apply h₁,
    exact (trans v u₀ u₁ r₀ r₁) },
  { intros h w v u rwv rvu,
    by_contradiction nr,
    have Vᵤ : ℕ → set W := λ e z, z ≠ u,
    specialize h Vᵤ w,
    have h₀ : [F, Vᵤ, w] ⊧ □p,
    { intros v' rwv',
      simp [satisfy],
      by_contradiction,
      sorry },
    sorry }
end
-/

lemma us_soundness : F ⊧ φ → F ⊧ (subst p ψ φ) :=
begin
  intros h V w,
  let V' : ℕ → set W := fun e u, [F, V, u] ⊧ subst p ψ e,
  have i : ∀ v, ([F, V', v] ⊧ φ) ↔ ([F, V, v] ⊧ subst p ψ φ),
  { clear h,
    induction φ,
    { exact λ v, ⟨λ h₀, h₀, λ h₀, h₀⟩ },
    { exact λ v, ⟨λ h₀, h₀, λ h₀, h₀⟩ },
    { exact λ v, ⟨λ h₀ s, (φ_ih_ᾰ_1 v).1 (h₀ ((φ_ih_ᾰ v).2 s)), λ h₀ s, (φ_ih_ᾰ_1 v).2 (h₀ ((φ_ih_ᾰ v).1 s))⟩ },
    { exact λ v, ⟨λ h u rvu, (φ_ih u).1 (h u rvu), λ h u rvu, (φ_ih u).2 (h u rvu)⟩ } },
  have l : [F, V', w] ⊧ φ := h V' w,
  exact (i w).1 l
end

lemma mp_soundness : F ⊧ φ →ₘ ψ → F ⊧ φ → F ⊧ ψ := λ h h₀ V w, (h V w) (h₀ V w)

lemma ak_soundness : F ⊧ φ →ₘ ψ →ₘ φ := λ V w h h₀, h

lemma as_soundness : F ⊧ (φ →ₘ ψ →ₘ χ) →ₘ (φ →ₘ ψ) →ₘ φ →ₘ χ := λ V w h h₀ h₁, h h₁ (h₀ h₁)

lemma an_soundness : F ⊧ (¬ₘφ →ₘ ¬ₘψ) →ₘ ψ →ₘ φ := by { intros V w h, simp [satisfy], contrapose, exact h }

theorem soundness : ⊢ₖ φ → F ⊧ φ :=
begin
  assume h,
  induction h,
  { exact us_soundness _ h_p _ _ h_ih },
  { exfalso, exact h_ᾰ },
  { exact mp_soundness _ _ _ h_ih_ᾰ h_ih_ᾰ_1 },
  { exact necessitation _ _ h_ih },
  { exact ak_soundness _ _ _ },
  { exact as_soundness _ _ _ _ },
  { exact an_soundness _ _ _ },
  { exact distribution _ _ _ }
end

theorem consis : consistent ∅ := λ h, soundness trivial_frame ⊥ₘ h (λ n, ∅) singleton.s

end semantics


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module measure_theory.measure.giry_monad
! leanprover-community/mathlib commit 56f4cd1ef396e9fd389b5d8371ee9ad91d163625
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.Lebesgue

/-!
# The Giry monad

Let X be a measurable space. The collection of all measures on X again
forms a measurable space. This construction forms a monad on
measurable spaces and measurable functions, called the Giry monad.

Note that most sources use the term "Giry monad" for the restriction
to *probability* measures. Here we include all measures on X.

See also `measure_theory/category/Meas.lean`, containing an upgrade of the type-level
monad to an honest monad of the functor `Measure : Meas ⥤ Meas`.

## References

* <https://ncatlab.org/nlab/show/Giry+monad>

## Tags

giry monad
-/

noncomputable section

open Classical BigOperators ENNReal

open Classical Set Filter

variable {α β : Type _}

namespace MeasureTheory

namespace Measure

variable [MeasurableSpace α] [MeasurableSpace β]

/-- Measurability structure on `measure`: Measures are measurable w.r.t. all projections -/
instance : MeasurableSpace (Measure α) :=
  ⨆ (s : Set α) (hs : MeasurableSet s), (borel ℝ≥0∞).comap fun μ => μ s

theorem measurable_coe {s : Set α} (hs : MeasurableSet s) : Measurable fun μ : Measure α => μ s :=
  Measurable.of_comap_le <| le_supᵢ_of_le s <| le_supᵢ_of_le hs <| le_rfl
#align measure_theory.measure.measurable_coe MeasureTheory.Measure.measurable_coe

theorem measurable_of_measurable_coe (f : β → Measure α)
    (h : ∀ (s : Set α) (hs : MeasurableSet s), Measurable fun b => f b s) : Measurable f :=
  Measurable.of_le_map <|
    supᵢ₂_le fun s hs =>
      MeasurableSpace.comap_le_iff_le_map.2 <| by rw [MeasurableSpace.map_comp] <;> exact h s hs
#align measure_theory.measure.measurable_of_measurable_coe MeasureTheory.Measure.measurable_of_measurable_coe

instance {α : Type _} {m : MeasurableSpace α} : HasMeasurableAdd₂ (Measure α) :=
  by
  refine' ⟨measure.measurable_of_measurable_coe _ fun s hs => _⟩
  simp_rw [measure.coe_add, Pi.add_apply]
  refine' Measurable.add _ _
  · exact (measure.measurable_coe hs).comp measurable_fst
  · exact (measure.measurable_coe hs).comp measurable_snd

theorem measurable_measure {μ : α → Measure β} :
    Measurable μ ↔ ∀ (s : Set β) (hs : MeasurableSet s), Measurable fun b => μ b s :=
  ⟨fun hμ s hs => (measurable_coe hs).comp hμ, measurable_of_measurable_coe μ⟩
#align measure_theory.measure.measurable_measure MeasureTheory.Measure.measurable_measure

theorem measurable_map (f : α → β) (hf : Measurable f) : Measurable fun μ : Measure α => map f μ :=
  by
  refine' measurable_of_measurable_coe _ fun s hs => _
  simp_rw [map_apply hf hs]
  exact measurable_coe (hf hs)
#align measure_theory.measure.measurable_map MeasureTheory.Measure.measurable_map

theorem measurable_dirac : Measurable (Measure.dirac : α → Measure α) :=
  by
  refine' measurable_of_measurable_coe _ fun s hs => _
  simp_rw [dirac_apply' _ hs]
  exact measurable_one.indicator hs
#align measure_theory.measure.measurable_dirac MeasureTheory.Measure.measurable_dirac

theorem measurable_lintegral {f : α → ℝ≥0∞} (hf : Measurable f) :
    Measurable fun μ : Measure α => ∫⁻ x, f x ∂μ :=
  by
  simp only [lintegral_eq_supr_eapprox_lintegral, hf, simple_func.lintegral]
  refine' measurable_supᵢ fun n => Finset.measurable_sum _ fun i _ => _
  refine' Measurable.const_mul _ _
  exact measurable_coe ((simple_func.eapprox f n).measurableSet_preimage _)
#align measure_theory.measure.measurable_lintegral MeasureTheory.Measure.measurable_lintegral

/-- Monadic join on `measure` in the category of measurable spaces and measurable
functions. -/
def join (m : Measure (Measure α)) : Measure α :=
  Measure.ofMeasurable (fun s hs => ∫⁻ μ, μ s ∂m)
    (by simp only [measure_empty, lintegral_const, MulZeroClass.zero_mul])
    (by
      intro f hf h
      simp_rw [measure_Union h hf]
      apply lintegral_tsum
      intro i; exact (measurable_coe (hf i)).AeMeasurable)
#align measure_theory.measure.join MeasureTheory.Measure.join

@[simp]
theorem join_apply {m : Measure (Measure α)} {s : Set α} (hs : MeasurableSet s) :
    join m s = ∫⁻ μ, μ s ∂m :=
  Measure.ofMeasurable_apply s hs
#align measure_theory.measure.join_apply MeasureTheory.Measure.join_apply

@[simp]
theorem join_zero : (0 : Measure (Measure α)).join = 0 :=
  by
  ext1 s hs
  simp only [hs, join_apply, lintegral_zero_measure, coe_zero, Pi.zero_apply]
#align measure_theory.measure.join_zero MeasureTheory.Measure.join_zero

theorem measurable_join : Measurable (join : Measure (Measure α) → Measure α) :=
  measurable_of_measurable_coe _ fun s hs => by
    simp only [join_apply hs] <;> exact measurable_lintegral (measurable_coe hs)
#align measure_theory.measure.measurable_join MeasureTheory.Measure.measurable_join

theorem lintegral_join {m : Measure (Measure α)} {f : α → ℝ≥0∞} (hf : Measurable f) :
    (∫⁻ x, f x ∂join m) = ∫⁻ μ, ∫⁻ x, f x ∂μ ∂m :=
  by
  simp_rw [lintegral_eq_supr_eapprox_lintegral hf, simple_func.lintegral,
    join_apply (simple_func.measurable_set_preimage _ _)]
  suffices
    ∀ (s : ℕ → Finset ℝ≥0∞) (f : ℕ → ℝ≥0∞ → Measure α → ℝ≥0∞) (hf : ∀ n r, Measurable (f n r))
      (hm : Monotone fun n μ => ∑ r in s n, r * f n r μ),
      (⨆ n, ∑ r in s n, r * ∫⁻ μ, f n r μ ∂m) = ∫⁻ μ, ⨆ n, ∑ r in s n, r * f n r μ ∂m
    by
    refine'
      this (fun n => simple_func.range (simple_func.eapprox f n))
        (fun n r μ => μ (simple_func.eapprox f n ⁻¹' {r})) _ _
    · exact fun n r => measurable_coe (simple_func.measurable_set_preimage _ _)
    · exact fun n m h μ => simple_func.lintegral_mono (simple_func.monotone_eapprox _ h) le_rfl
  intro s f hf hm
  rw [lintegral_supr _ hm]
  swap
  · exact fun n => Finset.measurable_sum _ fun r _ => (hf _ _).const_mul _
  congr
  funext n
  rw [lintegral_finset_sum (s n)]
  · simp_rw [lintegral_const_mul _ (hf _ _)]
  · exact fun r _ => (hf _ _).const_mul _
#align measure_theory.measure.lintegral_join MeasureTheory.Measure.lintegral_join

/-- Monadic bind on `measure`, only works in the category of measurable spaces and measurable
functions. When the function `f` is not measurable the result is not well defined. -/
def bind (m : Measure α) (f : α → Measure β) : Measure β :=
  join (map f m)
#align measure_theory.measure.bind MeasureTheory.Measure.bind

@[simp]
theorem bind_zero_left (f : α → Measure β) : bind 0 f = 0 := by simp [bind]
#align measure_theory.measure.bind_zero_left MeasureTheory.Measure.bind_zero_left

@[simp]
theorem bind_zero_right (m : Measure α) : bind m (0 : α → Measure β) = 0 :=
  by
  ext1 s hs
  simp only [bind, hs, join_apply, coe_zero, Pi.zero_apply]
  rw [lintegral_map (measurable_coe hs) measurable_zero]
  simp only [Pi.zero_apply, coe_zero, lintegral_const, MulZeroClass.zero_mul]
#align measure_theory.measure.bind_zero_right MeasureTheory.Measure.bind_zero_right

@[simp]
theorem bind_zero_right' (m : Measure α) : bind m (fun _ => 0 : α → Measure β) = 0 :=
  bind_zero_right m
#align measure_theory.measure.bind_zero_right' MeasureTheory.Measure.bind_zero_right'

@[simp]
theorem bind_apply {m : Measure α} {f : α → Measure β} {s : Set β} (hs : MeasurableSet s)
    (hf : Measurable f) : bind m f s = ∫⁻ a, f a s ∂m := by
  rw [bind, join_apply hs, lintegral_map (measurable_coe hs) hf]
#align measure_theory.measure.bind_apply MeasureTheory.Measure.bind_apply

theorem measurable_bind' {g : α → Measure β} (hg : Measurable g) : Measurable fun m => bind m g :=
  measurable_join.comp (measurable_map _ hg)
#align measure_theory.measure.measurable_bind' MeasureTheory.Measure.measurable_bind'

theorem lintegral_bind {m : Measure α} {μ : α → Measure β} {f : β → ℝ≥0∞} (hμ : Measurable μ)
    (hf : Measurable f) : (∫⁻ x, f x ∂bind m μ) = ∫⁻ a, ∫⁻ x, f x ∂μ a ∂m :=
  (lintegral_join hf).trans (lintegral_map (measurable_lintegral hf) hμ)
#align measure_theory.measure.lintegral_bind MeasureTheory.Measure.lintegral_bind

theorem bind_bind {γ} [MeasurableSpace γ] {m : Measure α} {f : α → Measure β} {g : β → Measure γ}
    (hf : Measurable f) (hg : Measurable g) : bind (bind m f) g = bind m fun a => bind (f a) g :=
  by
  ext1 s hs
  simp_rw [bind_apply hs hg, bind_apply hs ((measurable_bind' hg).comp hf),
    lintegral_bind hf ((measurable_coe hs).comp hg), bind_apply hs hg]
#align measure_theory.measure.bind_bind MeasureTheory.Measure.bind_bind

theorem bind_dirac {f : α → Measure β} (hf : Measurable f) (a : α) : bind (dirac a) f = f a :=
  by
  ext1 s hs
  rw [bind_apply hs hf, lintegral_dirac' a ((measurable_coe hs).comp hf)]
#align measure_theory.measure.bind_dirac MeasureTheory.Measure.bind_dirac

theorem dirac_bind {m : Measure α} : bind m dirac = m :=
  by
  ext1 s hs
  simp only [bind_apply hs measurable_dirac, dirac_apply' _ hs, lintegral_indicator 1 hs,
    Pi.one_apply, lintegral_one, restrict_apply, MeasurableSet.univ, univ_inter]
#align measure_theory.measure.dirac_bind MeasureTheory.Measure.dirac_bind

theorem join_eq_bind (μ : Measure (Measure α)) : join μ = bind μ id := by rw [bind, map_id]
#align measure_theory.measure.join_eq_bind MeasureTheory.Measure.join_eq_bind

theorem join_map_map {f : α → β} (hf : Measurable f) (μ : Measure (Measure α)) :
    join (map (map f) μ) = map f (join μ) := by
  ext1 s hs
  rw [join_apply hs, map_apply hf hs, join_apply (hf hs),
    lintegral_map (measurable_coe hs) (measurable_map f hf)]
  simp_rw [map_apply hf hs]
#align measure_theory.measure.join_map_map MeasureTheory.Measure.join_map_map

theorem join_map_join (μ : Measure (Measure (Measure α))) : join (map join μ) = join (join μ) :=
  by
  show bind μ join = join (join μ)
  rw [join_eq_bind, join_eq_bind, bind_bind measurable_id measurable_id]
  apply congr_arg (bind μ)
  funext ν
  exact join_eq_bind ν
#align measure_theory.measure.join_map_join MeasureTheory.Measure.join_map_join

theorem join_map_dirac (μ : Measure α) : join (map dirac μ) = μ :=
  dirac_bind
#align measure_theory.measure.join_map_dirac MeasureTheory.Measure.join_map_dirac

theorem join_dirac (μ : Measure α) : join (dirac μ) = μ :=
  (join_eq_bind (dirac μ)).trans (bind_dirac measurable_id _)
#align measure_theory.measure.join_dirac MeasureTheory.Measure.join_dirac

end Measure

end MeasureTheory


/- Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Douglas, Floris van Doorn
-/
import .basic
/- everything we have done that uses bilinear forms-/
universe variables u v w w' w''

open linear_map

variables {G : Type u} {R : Type v} {M : Type w} {M' : Type w'} {M'' : Type w''}
  [group G] [comm_ring R] [add_comm_group M] [module R M] [add_comm_group M'] [module R M']
  [add_comm_group M''] [module R M'']

namespace submodule

/-- `π` is a projection with as range `N` -/
def is_projection_on_submodule (N : submodule R M) (π : M →ₗ[R] M) : Prop :=
is_projection π ∧ range π = N

def is_orthogonal_projection_on_submodule (B : bilin_form R M) (N : submodule R M) (π : M →ₗ[R] M) :
  Prop :=
is_projection_on_submodule N π ∧ ∀ x : M, ∀ y : N, bilin_form.is_ortho B x y → π x = 0

lemma exists_orthogonal_projection_on_submodule (B : bilin_form R M) (N : submodule R M) :
  ∃ π : M →ₗ[R] M, is_orthogonal_projection_on_submodule B N π :=
sorry

lemma orthogonal_projection_on_submodule_range (B : bilin_form R M) (N : submodule R M)
  (π : M →ₗ[R] M) : is_projection_on_submodule N π → ∀ x : M, π x ∈ N :=
begin
  unfold is_projection_on_submodule, unfold is_projection, intro, sorry,
end

/-- A bilinear form is nondegenerate if `B x (-)` is the zero function only if `x` is zero. -/
def nondegenerate (B : bilin_form R M) : Prop :=
∀ x : M, (∀ y : M, B x y = 0) → x = 0

lemma nondegenerate_bilinear_form_exists : ∃ B : bilin_form R M, nondegenerate B := sorry
/- sum over a noncanonical basis - does this require R to be a field ?  -/

/- `is_orthogonal B N N'` states that `N` and `N'` are orthogonal w.r.t. bilinear form `B`. -/
def is_orthogonal (B : bilin_form R M) (N N' : submodule R M) : Prop :=
∀ x y, x ∈ N → y ∈ N' → bilin_form.is_ortho B x y

/- The orthogonal complement of a submodule w.r.t. a bilinear form. -/
@[simps] def orthogonal_complement (B : bilin_form R M) (N : submodule R M) : submodule R M :=
{ carrier := {x:M|∀ y ∈ N, bilin_form.is_ortho B x y},
  zero := λ y hy, bilin_form.ortho_zero y,
  add := λ x y hx hy z hz,
  begin
    unfold bilin_form.is_ortho at *, simp [bilin_form.add_left], simp [hx z hz, hy z hz],
  end,
  smul := λ r x hx y hy,
  by { unfold bilin_form.is_ortho at *, rw [bilin_form.smul_left, hx y hy, mul_zero] } }

--lemma orthogonal_complement_bijective_to_quotient {B : bilin_form R M} (N : submodule R M) :
--  linear_algebra.of_bijective _ _ := sorry

lemma orthogonal_projection_on_submodule_coker (B : bilin_form R M) (N : submodule R M) (π : M →ₗ[R] M) :
  is_projection_on_submodule N π → ∀ x : M, x - π x ∈ orthogonal_complement B N :=
begin
  unfold is_projection_on_submodule, unfold is_projection, intro, sorry,
end

/- A bilinear form is definite if `B x x = 0` only when `x = 0`. -/
def is_definite (B : bilin_form R M) : Prop :=
∀ x, B x x = 0 → x = 0

lemma orthogonal_complement_is_complementary (B : bilin_form R M) (N : submodule R M)
  (hB : is_definite B) : complementary N (orthogonal_complement B N) :=
begin
  intros, split,
  rcases exists_orthogonal_projection_on_submodule B N with ⟨π, hπ⟩,
  { rw [covering_iff, eq_top_iff'], intro, rw mem_sup, simp, use π x, split,
    apply orthogonal_projection_on_submodule_range B _ _ hπ.1,
    use (x - π x), simp [orthogonal_projection_on_submodule_coker, hπ.1] },
  { rw [disjoint_def], intros x hx h2x, apply hB, apply h2x, exact hx }
end

lemma is_orthogonal_orthogonal_complement (B : bilin_form R M) (N : submodule R M)
  : is_orthogonal B (orthogonal_complement B N) N :=
by { intros x y hx hy, exact hx y hy }

def conjugated_bilinear_form (ρ : group_representation G R M) (B : bilin_form R M) (g : G) :
  bilin_form R M :=
B.comp (ρ g) (ρ g)

/-- A bilinear form `B` is invariant under a representation `ρ` if `B = B ∘ (ρ g × ρ g)` for all `g`. -/
def is_invariant (ρ : group_representation G R M) (B : bilin_form R M) : Prop :=
∀ g : G, B = B.comp (ρ g) (ρ g)

/-- The standard bilinear form for a finite group `G`, defined by summing over all group elements. -/
def standard_invariant_bilinear_form [fintype G] (ρ : group_representation G R M)
  (B : bilin_form R M) : bilin_form R M :=
finset.univ.sum (λ g : G, B.comp (ρ g) (ρ g))

lemma sum_apply {α} (s : finset α) (f : α → bilin_form R M) (m m' : M) :
  s.sum f m m' = s.sum (λ x, f x m m') :=
begin
  sorry
end

lemma is_invariant_standard_invariant_bilinear_form [fintype G] (ρ : group_representation G R M)
  (B : bilin_form R M) : is_invariant ρ (standard_invariant_bilinear_form ρ B) :=
begin
  unfold standard_invariant_bilinear_form,
  intro g1, ext, simp [sum_apply], symmetry,
  apply finset.sum_bij (λ g _, g * g1),
  { intros, apply finset.mem_univ },
  { intros, apply bilin_form.coe_fn_congr, repeat { dsimp, rw ρ.map_mul, refl } },
  { intros g g' _ _ h, simpa using h },
  { intros, use b * g1⁻¹, simp }
end

lemma is_invariant_orthogonal_complement {ρ : group_representation G R M} (B : bilin_form R M) :
  ∀ N N' : submodule R M, is_invariant ρ B → N.invariant_under ρ → is_orthogonal B N' N →
  N'.invariant_under ρ :=
begin
  unfold is_invariant, unfold invariant_under, unfold is_orthogonal,
  intros N N' hρ hN hN' x g, dsimp,
  unfold bilin_form.is_ortho at hN', rw [hρ g] at hN', dsimp at hN',
  -- at this point hN with hN' imply that ρ g x is in the orthogonal complement.  by definition this is N'.
  sorry
end

theorem maschke [fintype G] (ρ : group_representation G R M) (B : bilin_form R M) :
  ∀ N : submodule R M, N.invariant_under ρ →
  ∃ N' : submodule R M, N'.invariant_under ρ ∧ complementary N N' :=
begin
  intros N hN,
  let std := standard_invariant_bilinear_form ρ B,
  let N' := orthogonal_complement std N,
  have h := is_invariant_orthogonal_complement std N N'
           (is_invariant_standard_invariant_bilinear_form ρ B) hN
           (is_orthogonal_orthogonal_complement _ _),
  use N', use h,
  apply orthogonal_complement_is_complementary, sorry,
 end

end submodule


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1),
    from by auto [polynomial.bernoulli, polynomial.eval_C, polynomial.eval_X, polynomial.eval_add, polynomial.eval_mul, polynomial.eval_pow, polynomial.eval_one, polynomial.eval_zero, polynomial.eval_neg, polynomial.eval_sub, polynomial.eval_nat_cast, polynomial.eval_nat_cast_zero, polynomial.eval_nat_cast_one, polynomial.eval_nat_cast_add, polynomial.eval_nat_cast_mul, polynomial.eval_nat_cast_pow, polynomial.eval_nat_cast_sub, polynomial.eval_nat_cast_neg, polynomial.eval_nat_cast_inv, polynomial.eval_nat_cast_div, polynomial.eval_nat_cast_bit0, polynomial.eval_nat_cast_bit1, polynomial.eval_nat_cast_one_div, polynomial.eval_nat_cast_bit0_div, polynomial.eval_nat_cast_bit1_div, polynomial.eval_nat_cast_bit0_div_bit0, polynomial.eval_nat_cast_bit0_div_bit1, polynomial.eval_nat_cast_bit1_div_bit0, polynomial.eval_nat_cast_bit1_div_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit1_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit0_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit1_bit1_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit0_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit0_bit1_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit0_bit1_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit0_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit0_bit1, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit1_bit0, polynomial.eval_nat_cast_bit1_div_bit1_bit1_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit0_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit1_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit0_bit1_bit1, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit1_bit0_bit0, polynomial.eval_nat_cast_bit0_div_bit0_bit0_bit1_bit0_bit
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.analytic.basic
import Mathlib.analysis.special_functions.pow
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Representation of `formal_multilinear_series.radius` as a `liminf`

In this file we prove that the radius of convergence of a `formal_multilinear_series` is equal to
$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{∥p n∥}}$. This lemma can't go to `basic.lean` because this
would create a circular dependency once we redefine `exp` using `formal_multilinear_series`.
-/

namespace formal_multilinear_series

/-- The radius of a formal multilinear series is equal to
$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{∥p n∥}}$. The actual statement uses `ℝ≥0` and some
coercions. -/
theorem radius_eq_liminf {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (p : formal_multilinear_series 𝕜 E F) : radius p = filter.liminf filter.at_top fun (n : ℕ) => 1 / ↑(nnnorm (p n) ^ (1 / ↑n)) := sorry


import kassel.enhanced_R_matrix
import kassel.lemma.to_matrix
import kassel.lemma.FinVect_right_pivotal
import tactic.field_simp

namespace kassel

namespace jones

variables {K: Type*} [field K]

open_locale big_operators matrix kronecker

section lemmas

lemma matrix.ext' {m n} [fintype n] [decidable_eq n] (A B: matrix m n K)
  (h: ∀ (v: n → K), A.mul_vec v = B.mul_vec v): A = B :=
begin
  ext i j,
  have h' := h (pi.single j (1: K)),
  simp [matrix.mul_vec_single] at h',
  change (λ i, A i j) i = (λ i, B i j) i,
  rw h',
end

lemma matrix.smul_apply {m n} (A: matrix m n K) (s: K) (x y):
  (s • A) x y = s * (A x y) :=
by simp

lemma matrix.mul_vec_apply {m n} [fintype n] (A: matrix m n K) (v: n → K):
  A.mul_vec v = λ i, ∑ j, A i j * v j :=
by ext j; rw [matrix.mul_vec, matrix.dot_product]

lemma matrix.kronecker_apply' {l m n o} (A: matrix l m K) (B: matrix n o K) (x y):
  (A ⊗ₖ B) x y = A x.1 y.1 * B x.2 y.2 :=
by simp

@[simp] lemma fintype.sum_unit (f: unit → K): ∑ (x : unit), f x = f unit.star :=
by rw [fintype.univ_punit, finset.sum_singleton]

lemma equiv.prod_punit_symm_apply {n x}: (equiv.prod_punit n).symm x = (x, punit.star) := by simp

end lemmas

section

variables (q: Kˣ)

@[simp] def R_matrix: matrix (bool × bool) (bool × bool) K
  | (ff, ff) (ff, ff) := q⁻¹
  | (ff, tt) (tt, ff) := (q⁻¹)^2
  | (tt, ff) (ff, tt) := (q⁻¹)^2
  | (tt, ff) (tt, ff) := q⁻¹ + -(q⁻¹)^3
  | (tt, tt) (tt, tt) := q⁻¹
  | _ _ := 0

@[simp] def R_matrix_inv: matrix (bool × bool) (bool × bool) K
  | (ff, ff) (ff, ff) := q
  | (ff, tt) (ff, tt) := q + -q^3
  | (ff, tt) (tt, ff) := q^2
  | (tt, ff) (ff, tt) := q^2
  | (tt, tt) (tt, tt) := q
  | _ _ := 0

@[simp] def μ_matrix: matrix bool bool K
  | ff ff := q
  | tt tt := q⁻¹
  | _ _ := 0

@[simp] def μ_matrix_inv: matrix bool bool K
  | ff ff := q⁻¹
  | tt tt := q
  | _ _ := 0

noncomputable def R_hom :=
  matrix.to_lin
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
    (R_matrix q)

noncomputable def R_inv :=
  matrix.to_lin
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
    (R_matrix_inv q)

noncomputable def μ_hom :=
  matrix.to_lin (pi.basis_fun K bool) (pi.basis_fun K bool) (μ_matrix q)

noncomputable def μ_inv :=
  matrix.to_lin (pi.basis_fun K bool) (pi.basis_fun K bool) (μ_matrix_inv q)

end

variables (q: Kˣ) (K)

lemma R_hom_inv_id: R_inv q ∘ₗ R_hom q = linear_map.id := begin
  rw [R_hom, R_inv, ←matrix.to_lin_mul],
  rw ←matrix.to_lin_one ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)),
  congr,
  ext ⟨x₁, x₂⟩ ⟨y₁, y₂⟩,
  rw matrix.mul_apply,
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  cases x₁; cases x₂; cases y₁; cases y₂; simp,
  field_simp, ring,
end

lemma R_inv_hom_id: R_hom q ∘ₗ R_inv q = linear_map.id := begin
  rw [R_hom, R_inv, ←matrix.to_lin_mul],
  rw ←matrix.to_lin_one ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)),
  congr,
  ext ⟨x₁, x₂⟩ ⟨y₁, y₂⟩,
  rw matrix.mul_apply,
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  cases x₁; cases x₂; cases y₁; cases y₂; simp,
  field_simp, ring,
end

lemma μ_hom_inv_id: μ_inv q ∘ₗ μ_hom q = linear_map.id :=
begin
  rw [μ_hom, μ_inv, ←matrix.to_lin_mul],
  rw ←matrix.to_lin_one (pi.basis_fun K bool),
  congr,
  ext x y,
  rw matrix.mul_apply,
  rw fintype.sum_bool,
  cases x; cases y; simp,
end

lemma μ_inv_hom_id: μ_hom q ∘ₗ μ_inv q = linear_map.id :=
begin
  rw [μ_hom, μ_inv, ←matrix.to_lin_mul],
  rw ←matrix.to_lin_one (pi.basis_fun K bool),
  congr,
  ext x y,
  rw matrix.mul_apply,
  rw fintype.sum_bool,
  cases x; cases y; simp,
end

lemma R_relation_1_matrix:
  associator.inv_matrix K ⬝
  1 ⊗ₖ R_matrix q ⬝
  associator.hom_matrix K ⬝
  R_matrix q ⊗ₖ 1 ⬝
  associator.inv_matrix K ⬝
  1 ⊗ₖ R_matrix q =
  R_matrix q ⊗ₖ 1 ⬝
  associator.inv_matrix K ⬝
  1 ⊗ₖ R_matrix q ⬝
  associator.hom_matrix K ⬝
  R_matrix q ⊗ₖ 1 ⬝
  associator.inv_matrix K :=
begin
  simp_rw [
    associator.inv_matrix_reindex,
    associator.hom_matrix_reindex_assoc,
    associator.inv_matrix_reindex_assoc
  ],
  apply matrix.ext',
  intro v,
  simp [←matrix.mul_vec_mul_vec],

  nth_rewrite 6 matrix.mul_vec_apply,
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],

  nth_rewrite 5 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_symm_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [associator.inv_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 4 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 3 matrix.mul_vec_apply,
  simp_rw [matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 2 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],

  nth_rewrite 1 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_symm_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 0 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  ext ⟨⟨x, y⟩, z⟩,
  cases x; cases y; cases z;
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false];
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one];
  ring,
end

lemma R_relation_1:
  associator.inv K _ _ _ ∘ₗ
  (tensor_product.map linear_map.id (R_hom q)) ∘ₗ
  associator.hom K _ _ _ ∘ₗ
  (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ _ ∘ₗ
  (tensor_product.map linear_map.id (R_hom q))
=
  (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ _ ∘ₗ
  (tensor_product.map linear_map.id (R_hom q)) ∘ₗ
  associator.hom K _ _ _ ∘ₗ
  (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ _
:= begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)))
    (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool))
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool)) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    linear_map.to_matrix_id,
    R_hom, linear_map.to_matrix_to_lin,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_1_matrix,
end

lemma R_relation_2_matrix:
  μ_matrix q ⊗ₖ μ_matrix q ⬝ R_matrix q = R_matrix q ⬝ μ_matrix q ⊗ₖ μ_matrix q :=
begin
  apply matrix.ext',
  intro v,
  simp [←matrix.mul_vec_mul_vec],

  nth_rewrite 3 matrix.mul_vec_apply,
  simp_rw matrix.kronecker_apply',
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],

  nth_rewrite 2 matrix.mul_vec_apply,
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw μ_matrix,
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 1 matrix.mul_vec_apply,
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],

  nth_rewrite 0 matrix.mul_vec_apply,
  simp_rw matrix.kronecker_apply',
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw R_matrix,
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  ext ⟨x, y⟩,
  cases x; cases y;
  simp_rw [R_matrix, μ_matrix];
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one];
  ring,
end

lemma R_relation_2:
  tensor_product.map (μ_hom q) (μ_hom q) ∘ₗ R_hom q
  = R_hom q ∘ₗ tensor_product.map (μ_hom q) (μ_hom q)
:= begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool))
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)) _,
    tensor_product.to_matrix
  ],
  simp_rw [R_hom, μ_hom, linear_map.to_matrix_to_lin],
  rw R_relation_2_matrix,
end

lemma R_relation_3_1_matrix:
  right_unitor.hom_matrix K bool ⬝
  (1: matrix bool bool K) ⊗ₖ evaluation.matrix K bool ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix q ⬝ R_matrix q) ⊗ₖ 1 ⬝
  associator.inv_matrix K ⬝
  1 ⊗ₖ coevaluation.matrix K bool ⬝
  right_unitor.inv_matrix K bool =
  1 :=
begin
  simp_rw [
    associator.hom_matrix_reindex_assoc,
    associator.inv_matrix_reindex_assoc,
    right_unitor.hom_matrix_reindex
  ],
  apply matrix.ext',
  intro v,
  simp [←matrix.mul_vec_mul_vec],

  nth_rewrite 3 matrix.mul_vec_apply,
  simp_rw fintype.sum_bool,

  nth_rewrite 2 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool, fintype.sum_unit],
  simp_rw [right_unitor.inv_matrix, coevaluation.matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 1 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_symm_apply, id],
  simp only [matrix.kronecker_apply', matrix.one_apply, matrix.mul_apply, matrix.smul_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 0 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_punit_symm_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [evaluation.matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  ext x,
  cases x;
  simp_rw [eq_self_iff_true, if_true, if_false];
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one];
  ring_nf; field_simp; ring,
end

lemma R_relation_3_1:
  right_unitor.hom K _ ∘ₗ
  tensor_product.map linear_map.id (evaluation.rev K _) ∘ₗ
  associator.hom K _ _ _ ∘ₗ
  tensor_product.map (
    tensor_product.map linear_map.id (μ_hom q) ∘ₗ R_hom q
  ) linear_map.id ∘ₗ
  associator.inv K _ _ _ ∘ₗ
  (tensor_product.map linear_map.id (coevaluation.hom K (bool → K))) ∘ₗ
  right_unitor.inv K _ =
  linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    (pi.basis_fun K bool)
    (pi.basis_fun K bool)
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_hom, μ_hom, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    right_unitor.hom_to_matrix,
    right_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_3_1_matrix,
end

lemma R_relation_3_2_matrix:
  right_unitor.hom_matrix K bool ⬝
  (1: matrix bool bool K) ⊗ₖ evaluation.matrix K bool ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix q ⬝ R_matrix_inv q) ⊗ₖ 1 ⬝
  associator.inv_matrix K ⬝
  1 ⊗ₖ coevaluation.matrix K bool ⬝
  right_unitor.inv_matrix K bool =
  1 :=
begin
  simp_rw [
    associator.hom_matrix_reindex_assoc,
    associator.inv_matrix_reindex_assoc,
    right_unitor.hom_matrix_reindex
  ],
  apply matrix.ext',
  intro v,
  simp [←matrix.mul_vec_mul_vec],

  nth_rewrite 3 matrix.mul_vec_apply,
  simp_rw fintype.sum_bool,

  nth_rewrite 2 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool, fintype.sum_unit],
  simp_rw [right_unitor.inv_matrix, coevaluation.matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 1 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_assoc_symm_apply, id],
  simp only [matrix.kronecker_apply', matrix.one_apply, matrix.mul_apply, matrix.smul_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [R_matrix_inv, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  nth_rewrite 0 matrix.mul_vec_apply,
  simp_rw [matrix.submatrix_apply, equiv.prod_punit_symm_apply, id, matrix.kronecker_apply', matrix.one_apply],
  simp_rw [←finset.univ_product_univ, finset.sum_product, fintype.sum_bool],
  simp_rw [evaluation.matrix, eq_self_iff_true, if_true, if_false],
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one],

  ext x,
  cases x;
  simp_rw [eq_self_iff_true, if_true, if_false];
  simp only [add_zero, zero_add, mul_zero, zero_mul, one_mul, mul_one];
  ring_nf; field_simp; ring,
end

lemma R_relation_3_2:
  right_unitor.hom K _ ∘ₗ
  tensor_product.map linear_map.id (evaluation.rev K _) ∘ₗ
  associator.hom K _ _ _ ∘ₗ
  tensor_product.map (
    tensor_product.map linear_map.id (μ_hom q) ∘ₗ R_inv q
  ) linear_map.id ∘ₗ
  associator.inv K _ _ _ ∘ₗ
  (tensor_product.map linear_map.id (coevaluation.hom K (bool → K))) ∘ₗ
  right_unitor.inv K _ =
  linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    (pi.basis_fun K bool)
    (pi.basis_fun K bool)
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_inv, μ_hom, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    right_unitor.hom_to_matrix,
    right_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_3_2_matrix,
end

lemma R_relation_4_1_matrix:
  left_unitor.hom_matrix K (bool × bool) ⬝
  evaluation.matrix K bool ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  1 ⊗ₖ (R_matrix q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K) ⊗ₖ coevaluation.matrix K bool ⬝
  1 ⊗ₖ 1 ⊗ₖ (evaluation.matrix K bool ⬝ μ_matrix q ⊗ₖ 1) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  1 ⊗ₖ (R_matrix_inv q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix_inv q ⬝ coevaluation.matrix K bool) ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  left_unitor.inv_matrix K (bool × bool) =
  1 ⊗ₖ 1 :=
begin
  apply matrix.ext',
  intro v,
  iterate 15 {
    rw ←matrix.mul_vec_mul_vec,
    nth_rewrite 1 matrix.mul_vec_apply,
    simp [←finset.univ_product_univ, finset.sum_product, matrix.mul_apply],
  },
  rw matrix.mul_vec_apply,
  simp [←finset.univ_product_univ, finset.sum_product, matrix.smul_mul_vec_assoc],
  ext ⟨x, y⟩, cases x; cases y; ring_nf; field_simp; ring_nf; tauto,
end

lemma R_relation_4_1:
  left_unitor.hom K (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (evaluation.hom K (bool → K)) (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (tensor_product.map linear_map.id linear_map.id) (coevaluation.hom K (bool → K)) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id linear_map.id)
    (evaluation.rev K (bool → K) ∘ₗ tensor_product.map (μ_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_inv q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id (μ_inv q) ∘ₗ coevaluation.rev K (bool → K))
    (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  left_unitor.inv K (tensor_product K (bool → K) (module.dual K (bool → K))) =
  tensor_product.map linear_map.id linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((basis.singleton unit K).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis))) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_hom, R_inv, μ_hom, μ_inv, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    left_unitor.hom_to_matrix,
    left_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    coevaluation.rev_to_matrix,
    evaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_4_1_matrix,
end

lemma R_relation_4_2_matrix:
  left_unitor.hom_matrix K (bool × bool) ⬝
  evaluation.matrix K bool ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  1 ⊗ₖ (R_matrix_inv q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K) ⊗ₖ coevaluation.matrix K bool ⬝
  1 ⊗ₖ 1 ⊗ₖ (evaluation.matrix K bool ⬝ μ_matrix q ⊗ₖ 1) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  1 ⊗ₖ (R_matrix q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix_inv q ⬝ coevaluation.matrix K bool) ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  left_unitor.inv_matrix K (bool × bool) =
  1 ⊗ₖ 1 :=
begin
  apply matrix.ext',
  intro v,
  iterate 15 {
    rw ←matrix.mul_vec_mul_vec,
    nth_rewrite 1 matrix.mul_vec_apply,
    simp [←finset.univ_product_univ, finset.sum_product, matrix.mul_apply],
  },
  rw matrix.mul_vec_apply,
  simp [←finset.univ_product_univ, finset.sum_product, matrix.smul_mul_vec_assoc],
  ext ⟨x, y⟩, cases x; cases y; ring_nf; field_simp; ring_nf; tauto,
end

lemma R_relation_4_2:
  left_unitor.hom K (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (evaluation.hom K (bool → K)) (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_inv q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (tensor_product.map linear_map.id linear_map.id) (coevaluation.hom K (bool → K)) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id linear_map.id)
    (evaluation.rev K (bool → K) ∘ₗ tensor_product.map (μ_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id (μ_inv q) ∘ₗ coevaluation.rev K (bool → K))
    (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  left_unitor.inv K (tensor_product K (bool → K) (module.dual K (bool → K))) =
  tensor_product.map linear_map.id linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)
    ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ ((basis.singleton unit K).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis))) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_hom, R_inv, μ_hom, μ_inv, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    left_unitor.hom_to_matrix,
    left_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    coevaluation.rev_to_matrix,
    evaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_4_2_matrix,
end

lemma R_relation_4_3_matrix:
  right_unitor.hom_matrix K (bool × bool) ⬝
  1 ⊗ₖ 1 ⊗ₖ (evaluation.matrix K bool ⬝ μ_matrix q ⊗ₖ 1) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (R_matrix_inv q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix_inv q ⬝ coevaluation.matrix K bool) ⊗ₖ (1 ⊗ₖ 1) ⬝
  evaluation.matrix K bool ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (R_matrix q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ 1 ⊗ₖ coevaluation.matrix K bool ⬝
  right_unitor.inv_matrix K (bool × bool) =
  1 ⊗ₖ 1 :=
begin
  apply matrix.ext',
  intro v,
  iterate 15 {
    rw ←matrix.mul_vec_mul_vec,
    nth_rewrite 1 matrix.mul_vec_apply,
    simp [←finset.univ_product_univ, finset.sum_product, matrix.mul_apply],
  },
  rw matrix.mul_vec_apply,
  simp [←finset.univ_product_univ, finset.sum_product, matrix.smul_mul_vec_assoc],
  ext ⟨x, y⟩, cases x; cases y; ring_nf; field_simp; ring_nf; tauto,
end

lemma R_relation_4_3:
  right_unitor.hom K (tensor_product K (module.dual K (bool → K)) (bool → K)) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id linear_map.id)
    (evaluation.rev K (bool → K) ∘ₗ tensor_product.map (μ_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_inv q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id (μ_inv q) ∘ₗ coevaluation.rev K (bool → K))
    (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  tensor_product.map (evaluation.hom K (bool → K)) (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (tensor_product.map linear_map.id linear_map.id) (coevaluation.hom K (bool → K)) ∘ₗ
  right_unitor.inv K (tensor_product K (module.dual K (bool → K)) (bool → K)) =
  tensor_product.map linear_map.id linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool))
    ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool))
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis))) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((basis.singleton unit K).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_hom, R_inv, μ_hom, μ_inv, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    right_unitor.hom_to_matrix,
    right_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    coevaluation.rev_to_matrix,
    evaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_4_3_matrix,
end

lemma R_relation_4_4_matrix:
  right_unitor.hom_matrix K (bool × bool) ⬝
  1 ⊗ₖ 1 ⊗ₖ (evaluation.matrix K bool ⬝ μ_matrix q ⊗ₖ 1) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (R_matrix q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1 ⊗ₖ μ_matrix_inv q ⬝ coevaluation.matrix K bool) ⊗ₖ (1 ⊗ₖ 1) ⬝
  evaluation.matrix K bool ⊗ₖ ((1: matrix bool bool K) ⊗ₖ (1: matrix bool bool K)) ⬝
  associator.inv_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ (R_matrix_inv q ⊗ₖ (1: matrix bool bool K)) ⬝
  (1: matrix bool bool K) ⊗ₖ associator.inv_matrix K ⬝
  associator.hom_matrix K ⬝
  (1: matrix bool bool K) ⊗ₖ 1 ⊗ₖ coevaluation.matrix K bool ⬝
  right_unitor.inv_matrix K (bool × bool) =
  1 ⊗ₖ 1 :=
begin
  apply matrix.ext',
  intro v,
  iterate 15 {
    rw ←matrix.mul_vec_mul_vec,
    nth_rewrite 1 matrix.mul_vec_apply,
    simp [←finset.univ_product_univ, finset.sum_product, matrix.mul_apply],
  },
  rw matrix.mul_vec_apply,
  simp [←finset.univ_product_univ, finset.sum_product, matrix.smul_mul_vec_assoc],
  ext ⟨x, y⟩, cases x; cases y; ring_nf; field_simp; ring_nf; tauto,
end

lemma R_relation_4_4:
  right_unitor.hom K (tensor_product K (module.dual K (bool → K)) (bool → K)) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id linear_map.id)
    (evaluation.rev K (bool → K) ∘ₗ tensor_product.map (μ_hom q) linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_hom q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map
    (tensor_product.map linear_map.id (μ_inv q) ∘ₗ coevaluation.rev K (bool → K))
    (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  tensor_product.map (evaluation.hom K (bool → K)) (tensor_product.map linear_map.id linear_map.id) ∘ₗ
  associator.inv K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map linear_map.id (associator.hom K _ _ _) ∘ₗ
  tensor_product.map linear_map.id (tensor_product.map (R_inv q) linear_map.id) ∘ₗ
  tensor_product.map linear_map.id (associator.inv K _ _ _) ∘ₗ
  associator.hom K _ _ (tensor_product K (bool → K) (module.dual K (bool → K))) ∘ₗ
  tensor_product.map (tensor_product.map linear_map.id linear_map.id) (coevaluation.hom K (bool → K)) ∘ₗ
  right_unitor.inv K (tensor_product K (module.dual K (bool → K)) (bool → K)) =
  tensor_product.map linear_map.id linear_map.id :=
begin
  apply (equiv_like.apply_eq_iff_eq (linear_map.to_matrix
    ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool))
    ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool))
  )).mp,
  simp only [
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product (basis.singleton unit K)) _,
    linear_map.to_matrix_comp _ (((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product ((pi.basis_fun K bool).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis))) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool)).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((basis.singleton unit K).tensor_product ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).dual_basis.tensor_product (pi.basis_fun K bool)) _,
    linear_map.to_matrix_comp _ ((pi.basis_fun K bool).tensor_product (pi.basis_fun K bool).dual_basis) _,
    tensor_product.to_matrix
  ],
  simp_rw [
    R_hom, R_inv, μ_hom, μ_inv, linear_map.to_matrix_to_lin,
    linear_map.to_matrix_id,
    associator.hom_to_matrix,
    associator.inv_to_matrix,
    right_unitor.hom_to_matrix,
    right_unitor.inv_to_matrix,
    coevaluation.to_matrix,
    coevaluation.rev_to_matrix,
    evaluation.to_matrix,
    evaluation.rev_to_matrix,
    ←matrix.mul_assoc
  ],
  rw R_relation_4_4_matrix,
end

@[simp] def V₂: FinVect K := ⟨⟨bool → K⟩, begin
  change finite_dimensional K (bool → K),
  exact finite_dimensional.finite_dimensional_pi K,
end⟩

noncomputable def c': (V₂ K) ⊗ (V₂ K) ≅ (V₂ K) ⊗ (V₂ K) := {
  hom := R_hom q,
  inv := R_inv q,
  hom_inv_id' := by apply R_hom_inv_id K q,
  inv_hom_id' := by apply R_inv_hom_id K q
}

noncomputable def μ': (V₂ K) ≅ (V₂ K) := {
  hom := μ_hom q,
  inv := μ_inv q,
  hom_inv_id' := by apply μ_hom_inv_id K q,
  inv_hom_id' := by apply μ_inv_hom_id K q
}

noncomputable def jones_R_matrix: enhanced_R_matrix (FinVect K) (V₂ K) := {
  c := c' K q,
  μ := μ' K q,
  relation_1 := by apply R_relation_1 K q,
  relation_2 := by apply R_relation_2 K q,
  relation_3_1 := by rw trace_2; apply R_relation_3_1 K q,
  relation_3_2 := by rw trace_2; apply R_relation_3_2 K q,
  relation_4_1 := by apply R_relation_4_1 K q,
  relation_4_2 := by apply R_relation_4_2 K q,
  relation_4_3 := by apply R_relation_4_3 K q,
  relation_4_4 := by apply R_relation_4_4 K q,
}

end jones

end kassel