/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.MinkowskiMetric
import Mathlib.Algebra.Lie.Classical
/-!
# The Lorentz Algebra

We define

- Define `lorentzAlgebra` via `LieAlgebra.Orthogonal.so'` as a subalgebra of
  `Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ`.
- In `mem_iff` prove that a matrix is in the Lorentz algebra if and only if it satisfies the
  condition `Aᵀ * η = - η * A`.

-/

namespace SpaceTime
open Matrix
open TensorProduct

/-- The Lorentz algebra as a subalgebra of `Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ`. -/
def lorentzAlgebra : LieSubalgebra ℝ (Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ) :=
  (LieAlgebra.Orthogonal.so' (Fin 1) (Fin 3) ℝ)

namespace lorentzAlgebra
open minkowskiMatrix

lemma transpose_eta (A : lorentzAlgebra) : A.1ᵀ * η = - η * A.1 := by
  have h1 := A.2
  erw [mem_skewAdjointMatricesLieSubalgebra] at h1
  simpa [LieAlgebra.Orthogonal.so', IsSkewAdjoint, IsAdjointPair] using h1

lemma mem_of_transpose_eta_eq_eta_mul_self {A : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ}
    (h : Aᵀ * η = - η * A) : A ∈ lorentzAlgebra := by
  erw [mem_skewAdjointMatricesLieSubalgebra]
  simpa [LieAlgebra.Orthogonal.so', IsSkewAdjoint, IsAdjointPair] using h

lemma mem_iff {A : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ} :
    A ∈ lorentzAlgebra ↔ Aᵀ * η = - η * A

:=
  Iff.intro (fun h => transpose_eta ⟨A, h⟩) (fun h => mem_of_transpose_eta_eq_eta_mul_self h)


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import Mathlib.Algebra.Lie.Classical
/-!

# The Minkowski Metric

This file introduces the Minkowski metric on spacetime in the mainly-minus signature.

We define the Minkowski metric as a bilinear map on the vector space
of Lorentz vectors in d dimensions.

-/

open Matrix BigOperators

/-!

# The definition of the Minkowski Matrix

-/
/-- The `d.succ`-dimensional real matrix of the form `diag(1, -1, -1, -1, ...)`. -/
def minkowskiMatrix {d : ℕ} : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LieAlgebra.Orthogonal.indefiniteDiagonal (Fin 1) (Fin d) ℝ

namespace minkowskiMatrix

variable {d : ℕ}

/-- Notation for `minkowskiMatrix`. -/
scoped[minkowskiMatrix] notation "η" => minkowskiMatrix

@[simp]
lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1

:= by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal]
  ext1 i j
  rcases i with i | i <;> rcases j with j | j
  · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne]
  · rfl
  · rfl
  · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne]


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.NormOne
import HepLean.SpaceTime.LorentzGroup.Proper
/-!
# The Orthochronous Lorentz Group

We define the give a series of lemmas related to the orthochronous property of lorentz
matrices.

-/
/-! TODO: Prove topological properties of the Orthochronous Lorentz Group. -/

noncomputable section

open Matrix
open Complex
open ComplexConjugate

namespace LorentzGroup

variable {d : ℕ}
variable (Λ : LorentzGroup d)
open LorentzVector
open minkowskiMetric

/-- A Lorentz transformation is `orthochronous` if its `0 0` element is non-negative. -/
def IsOrthochronous : Prop := 0 ≤ timeComp Λ

lemma IsOrthochronous_iff_futurePointing :
    IsOrthochronous Λ ↔ (toNormOneLorentzVector Λ) ∈ NormOneLorentzVector.FuturePointing d := by
  simp only [IsOrthochronous, timeComp_eq_toNormOneLorentzVector]
  rw [NormOneLorentzVector.FuturePointing.mem_iff_time_nonneg]

lemma IsOrthochronous_iff_transpose :
    IsOrthochronous Λ ↔ IsOrthochronous (transpose Λ) := by rfl

lemma IsOrthochronous_iff_ge_one :
    IsOrthochronous Λ ↔ 1 ≤ timeComp Λ := by
  rw [IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.mem_iff,
    NormOneLorentzVector.time_pos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_neg_one :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ -1 := by
  rw [timeComp, IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.not_mem_iff,
    NormOneLorentzVector.time_nonpos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_zero :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · rw [not_orthochronous_iff_le_neg_one] at h
    linarith
  · rw [IsOrthochronous_iff_ge_one]
    linarith

/-- The continuous map taking a Lorentz transformation to its `0 0` element. -/
def timeCompCont : C(LorentzGroup d, ℝ) := ⟨fun Λ => timeComp Λ,
    Continuous.matrix_elem (continuous_iff_le_induced.mpr fun _ a => a) (Sum.inl 0) (Sum.inl 0)⟩

/-- An auxillary function used in the definition of `orthchroMapReal`. -/
def stepFunction : ℝ → ℝ := fun t =>
  if t ≤ -1 then -1 else
    if 1 ≤ t then 1 else t

lemma stepFunction_continuous : Continuous stepFunction := by
  apply Continuous.if ?_ continuous_const (Continuous.if ?_ continuous_const continuous_id)
    <;> intro a ha
  · rw [@Set.Iic_def, @frontier_Iic, @Set.mem_singleton_iff] at ha
    rw [ha]
    simp only [le_neg_self_iff, id_eq]
    have h1 : ¬ (1 : ℝ) ≤ 0 := by simp
    exact Eq.symm (if_neg h1)
  · rw [Set.Ici_def, @frontier_Ici, @Set.mem_singleton_iff] at ha
    exact id (Eq.symm ha)

/-- The continuous map from `lorentzGroup` to `ℝ` wh
taking Orthochronous elements to `1` and non-orthochronous to `-1`. -/
def orthchroMapReal : C(LorentzGroup d, ℝ) := ContinuousMap.comp
  ⟨stepFunction, stepFunction_continuous⟩ timeCompCont

lemma orthchroMapReal_on_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMapReal Λ = 1

:= by
  rw [IsOrthochronous_iff_ge_one, timeComp] at h
  change stepFunction (Λ.1 _ _) = 1
  rw [stepFunction, if_pos h, if_neg]
  linarith


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.LorentzAction
import HepLean.SpaceTime.LorentzVector.Covariant
import HepLean.Tensors.Basic
/-!

# Contractions of Lorentz vectors

We define the contraction between a covariant and contravariant Lorentz vector,
as well as properties thereof.

The structures in this file are used in `HepLean.SpaceTime.LorentzTensor.Real.Basic`
to define the contraction between indices of Lorentz tensors.

-/

noncomputable section

open TensorProduct BigOperators

namespace LorentzVector

open Matrix
variable {d : ℕ} (v : LorentzVector d)

/-- The bi-linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDownBi : LorentzVector d →ₗ[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ where
  toFun v := {
    toFun := fun w => ∑ i, v i * w i,
    map_add' := by
      intro w1 w2
      rw [← Finset.sum_add_distrib]
      refine Finset.sum_congr rfl (fun i _ => mul_add _ _ _)
    map_smul' := by
      intro r w
      simp only [RingHom.id_apply, smul_eq_mul]
      rw [Finset.mul_sum]
      refine Finset.sum_congr rfl (fun i _ => ?_)
      simp only [HSMul.hSMul, SMul.smul]
      ring}
  map_add' v1 v2 := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply]
    rw [← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl (fun i _ => add_mul _ _ _)
  map_smul' r v := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.smul_apply]
    rw [Finset.smul_sum]
    refine Finset.sum_congr rfl (fun i _ => ?_)
    simp only [HSMul.hSMul, SMul.smul]
    exact mul_assoc r (v i) (w i)

/-- The linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ :=
  TensorProduct.lift contrUpDownBi

lemma contrUpDown_tmul_eq_dotProduct {x : LorentzVector d} {y : CovariantLorentzVector d} :
    contrUpDown (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rfl

@[simp]
lemma contrUpDown_stdBasis_left (x : LorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (x ⊗ₜ[ℝ] (CovariantLorentzVector.stdBasis i)) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · simp only [CovariantLorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    apply Or.inr hbi.symm

@[simp]
lemma contrUpDown_stdBasis_right (x : CovariantLorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (e i ⊗ₜ[ℝ] x) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, one_mul]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    left
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    exact hbi.symm

/-- The linear map defining the contraction of a covariant Lorentz vector
  and a contravariant Lorentz vector. -/
def contrDownUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d →ₗ[ℝ] ℝ :=
  contrUpDown ∘ₗ (TensorProduct.comm ℝ _ _).toLinearMap

lemma contrDownUp_tmul_eq_dotProduct {x : CovariantLorentzVector d} {y : LorentzVector d} :
    contrDownUp (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rw [dotProduct_comm x y]
  rfl

/-!

## The unit of the contraction

-/

/-- The unit of the contraction of contravariant Lorentz vector and a
  covariant Lorentz vector. -/
def unitUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ i, CovariantLorentzVector.stdBasis i ⊗ₜ[ℝ] LorentzVector.stdBasis i

lemma unitUp_rid (x : LorentzVector d) :
    TensorStructure.contrLeftAux contrUpDown (x ⊗ₜ[ℝ] unitUp) = x := by
  simp only [unitUp, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, LinearEquiv.refl_toLinearMap, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, map_add,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul, map_sum, decomp_stdBasis']

/-- The unit of the contraction of covariant Lorentz vector and a
  contravariant Lorentz vector. -/
def unitDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ i, LorentzVector.stdBasis i ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis i

lemma unitDown_rid (x : CovariantLorentzVector d) :
    TensorStructure.contrLeftAux contrDownUp (x ⊗ₜ[ℝ] unitDown) = x := by
  simp only [unitDown, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap,
    Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply,
    assoc_symm_tmul, map_tmul, comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq,
    lid_tmul, map_sum, CovariantLorentzVector.decomp_stdBasis']

/-!

# Contractions and the Lorentz actions

-/
open Matrix

@[simp]
lemma contrUpDown_invariant_lorentzAction : @contrUpDown d ((LorentzVector.rep g) x ⊗ₜ[ℝ]
    (CovariantLorentzVector.rep g) y) = contrUpDown (x ⊗ₜ[ℝ] y) := by
  rw [contrUpDown_tmul_eq_dotProduct, contrUpDown_tmul_eq_dotProduct]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

@[simp]
lemma contrDownUp_invariant_lorentzAction : @contrDownUp d ((CovariantLorentzVector.rep g) x ⊗ₜ[ℝ]
    (LorentzVector.rep g) y) = contrDownUp (x ⊗ₜ[ℝ] y) := by
  rw [contrDownUp_tmul_eq_dotProduct, contrDownUp_tmul_eq_dotProduct]
  rw [dotProduct_comm, dotProduct_comm x y]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

end LorentzVector

namespace minkowskiMatrix
open LorentzVector
open TensorStructure
open scoped minkowskiMatrix
variable {d : ℕ}

/-- The metric tensor as an element of `LorentzVector d ⊗[ℝ] LorentzVector d`. -/
def asTenProd : LorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis ν)

lemma asTenProd_diag :
    @asTenProd d = ∑ μ, η μ μ • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis μ) := by
  simp only [asTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    exact TensorProduct.zero_smul (e μ ⊗ₜ[ℝ] e ν)
  · intro a
    rename_i j
    exact False.elim (a j)

/-- The metric tensor as an element of `CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d`. -/
def asCoTenProd : CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis ν)

lemma asCoTenProd_diag :
    @asCoTenProd d = ∑ μ, η μ μ • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ]
      CovariantLorentzVector.stdBasis μ) := by
  simp only [asCoTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    simp only [zero_smul]
  · intro a
    simp_all only

@[simp]
lemma contrLeft_asTenProd (x : CovariantLorentzVector d) :
    contrLeftAux contrDownUp (x ⊗ₜ[ℝ] asTenProd) =
    ∑ μ, ((η μ μ * x μ) • LorentzVector.stdBasis μ) := by
  simp only [asTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (e μ)

@[simp]
lemma contrLeft_asCoTenProd (x : LorentzVector d) :
    contrLeftAux contrUpDown (x ⊗ₜ[ℝ] asCoTenProd) =
    ∑ μ, ((η μ μ * x μ) • CovariantLorentzVector.stdBasis μ)

:= by
  simp only [asCoTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (CovariantLorentzVector.stdBasis μ)


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import Mathlib.Algebra.Lie.Classical
/-!

# The Minkowski Metric

This file introduces the Minkowski metric on spacetime in the mainly-minus signature.

We define the Minkowski metric as a bilinear map on the vector space
of Lorentz vectors in d dimensions.

-/

open Matrix BigOperators

/-!

# The definition of the Minkowski Matrix

-/
/-- The `d.succ`-dimensional real matrix of the form `diag(1, -1, -1, -1, ...)`. -/
def minkowskiMatrix {d : ℕ} : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LieAlgebra.Orthogonal.indefiniteDiagonal (Fin 1) (Fin d) ℝ

namespace minkowskiMatrix

variable {d : ℕ}

/-- Notation for `minkowskiMatrix`. -/
scoped[minkowskiMatrix] notation "η" => minkowskiMatrix

@[simp]
lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal]
  ext1 i j
  rcases i with i | i <;> rcases j with j | j
  · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne]
  · rfl
  · rfl
  · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne]

@[simp]
lemma eq_transpose : minkowskiMatrixᵀ = @minkowskiMatrix d := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_transpose]

@[simp]
lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by
  simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

@[simp]
lemma η_apply_mul_η_apply_diag (μ : Fin 1 ⊕ Fin d) : η μ μ * η μ μ = 1 := by
  match μ with
  | Sum.inl _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  | Sum.inr _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

lemma as_block : @minkowskiMatrix d = (
    Matrix.fromBlocks (1 : Matrix (Fin 1) (Fin 1) ℝ) 0 0 (-1 : Matrix (Fin d) (Fin d) ℝ)) := by
  rw [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, ← fromBlocks_diagonal]
  refine fromBlocks_inj.mpr ?_
  simp only [diagonal_one, true_and]
  funext i j
  rw [← diagonal_neg]
  rfl

@[simp]
lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  exact diagonal_apply_ne _ h

end minkowskiMatrix

/-!

# The definition of the Minkowski Metric

-/

/-- Given a Lorentz vector `v` we define the the linear map `w ↦ v * η * w`. -/
@[simps!]
def minkowskiLinearForm {d : ℕ} (v : LorentzVector d) : LorentzVector d →ₗ[ℝ] ℝ where
  toFun w := v ⬝ᵥ (minkowskiMatrix *ᵥ w)
  map_add' y z := by
    noncomm_ring
    rw [mulVec_add, dotProduct_add]
  map_smul' c y := by
    simp only [RingHom.id_apply, smul_eq_mul]
    rw [mulVec_smul, dotProduct_smul]
    rfl

/-- The Minkowski metric as a bilinear map. -/
def minkowskiMetric {d : ℕ} : LorentzVector d →ₗ[ℝ] LorentzVector d →ₗ[ℝ] ℝ where
  toFun v := minkowskiLinearForm v
  map_add' y z := by
    ext1 x
    simp only [minkowskiLinearForm_apply, LinearMap.add_apply]
    apply add_dotProduct
  map_smul' c y := by
    ext1 x
    simp only [minkowskiLinearForm_apply, RingHom.id_apply, LinearMap.smul_apply, smul_eq_mul]
    rw [smul_dotProduct]
    rfl

namespace minkowskiMetric

open minkowskiMatrix

open LorentzVector

variable {d : ℕ}
variable (v w : LorentzVector d)

/-- Notation for `minkowskiMetric`. -/
scoped[minkowskiMetric] notation:102 "⟪" v "," w "⟫ₘ" => minkowskiMetric v w
/-!

# Equalitites involving the Minkowski metric

-/

/-- The Minkowski metric expressed as a sum. -/
lemma as_sum :
    ⟪v, w⟫ₘ = v.time * w.time - ∑ i, v.space i * w.space i := by
  simp only [minkowskiMetric, LinearMap.coe_mk, AddHom.coe_mk, minkowskiLinearForm_apply,
    dotProduct, LieAlgebra.Orthogonal.indefiniteDiagonal, mulVec_diagonal, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Sum.elim_inl, one_mul,
    Finset.sum_singleton, Sum.elim_inr, neg_mul, mul_neg, Finset.sum_neg_distrib, time, space,
    Function.comp_apply, minkowskiMatrix]
  rfl

/-- The Minkowski metric expressed as a sum for a single vector. -/
lemma as_sum_self : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

lemma eq_time_minus_inner_prod : ⟪v, w⟫ₘ = v.time * w.time - ⟪v.space, w.space⟫_ℝ := by
  rw [as_sum, @PiLp.inner_apply]
  rfl

lemma self_eq_time_minus_norm : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

/-- The Minkowski metric is symmetric in its arguments.. -/
lemma symm : ⟪v, w⟫ₘ = ⟪w, v⟫ₘ := by
  simp only [as_sum]
  ac_rfl

lemma time_sq_eq_metric_add_space : v.time ^ 2 = ⟪v, v⟫ₘ + ‖v.space‖ ^ 2

:= by
  rw [self_eq_time_minus_norm]
  exact Eq.symm (sub_add_cancel (v.time ^ 2) (‖v.space‖ ^ 2))


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import HepLean.SpaceTime.LorentzGroup.Basic
import Mathlib.RepresentationTheory.Basic
/-!

# Lorentz group action on Lorentz vectors.

-/
noncomputable section

open BigOperators

namespace LorentzVector

variable {d : ℕ} (v : LorentzVector d)

/-- The contravariant action of the Lorentz group on a Lorentz vector. -/
def rep : Representation ℝ (LorentzGroup d) (LorentzVector d) where
  toFun g := Matrix.toLinAlgEquiv e g
  map_one' := (MulEquivClass.map_eq_one_iff (Matrix.toLinAlgEquiv e)).mpr rfl
  map_mul' x y := by
    simp only [lorentzGroupIsGroup_mul_coe, map_mul]

open Matrix in

lemma rep_apply (g : LorentzGroup d) : rep g v = g *ᵥ v


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzGroup.Proper
import Mathlib.Topology.Constructions
import HepLean.SpaceTime.LorentzVector.NormOne
/-!
# Boosts

This file defines those Lorentz which are boosts.

We first define generalised boosts, which are restricted lorentz transformations taking
a four velocity `u` to a four velocity `v`.

A boost is the special case of a generalised boost when `u = stdBasis 0`.

## References

- The main argument follows: Guillem Cobos, The Lorentz Group, 2015:
  https://diposit.ub.edu/dspace/bitstream/2445/68763/2/memoria.pdf

-/
/-! TODO: Show that generalised boosts are in the restricted Lorentz group. -/
noncomputable section

namespace LorentzGroup

open NormOneLorentzVector
open minkowskiMetric

variable {d : ℕ}

/-- An auxillary linear map used in the definition of a generalised boost. -/
def genBoostAux₁ (u v : FuturePointing d) : LorentzVector d →ₗ[ℝ] LorentzVector d where
  toFun x := (2 * ⟪x, u⟫ₘ) • v.1.1
  map_add' x y := by
    simp only [map_add, LinearMap.add_apply]
    rw [mul_add, add_smul]
  map_smul' c x := by
    simp only [map_smul, LinearMap.smul_apply, smul_eq_mul,
      RingHom.id_apply]
    rw [← mul_assoc, mul_comm 2 c, mul_assoc, mul_smul]

/-- An auxillary linear map used in the definition of a genearlised boost. -/
def genBoostAux₂ (u v : FuturePointing d) : LorentzVector d →ₗ[ℝ] LorentzVector d where
  toFun x := - (⟪x, u.1.1 + v⟫ₘ / (1 + ⟪u.1.1, v⟫ₘ)) • (u.1.1 + v)
  map_add' x y := by
    simp only
    rw [← add_smul]
    apply congrFun (congrArg _ _)
    field_simp
    apply congrFun (congrArg _ _)
    ring
  map_smul' c x := by
    simp only
    rw [map_smul, show (c • minkowskiMetric x) (↑u + ↑v) = c * minkowskiMetric x (u+v) from rfl,
      mul_div_assoc, neg_mul_eq_mul_neg, smul_smul]
    rfl

/-- An generalised boost. This is a Lorentz transformation which takes the four velocity `u`
to `v`. -/
def genBoost (u v : FuturePointing d) : LorentzVector d →ₗ[ℝ] LorentzVector d :=
  LinearMap.id + genBoostAux₁ u v + genBoostAux₂ u v

namespace genBoost

/--
  This lemma states that for a given four-velocity `u`, the general boost
  transformation `genBoost u u` is equal to the identity linear map `LinearMap.id`.
-/
lemma self (u : FuturePointing d) : genBoost u u = LinearMap.id := by
  ext x
  simp only [genBoost, LinearMap.add_apply, LinearMap.id_coe, id_eq]
  rw [add_assoc, add_right_eq_self, add_eq_zero_iff_eq_neg, genBoostAux₁, genBoostAux₂]
  simp only [LinearMap.coe_mk, AddHom.coe_mk, map_add, smul_add, neg_smul, neg_add_rev, neg_neg]
  rw [← add_smul]
  apply congrFun (congrArg _ _)
  rw [u.1.2]
  ring

/-- A generalised boost as a matrix. -/
def toMatrix (u v : FuturePointing d) : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LinearMap.toMatrix LorentzVector.stdBasis LorentzVector.stdBasis (genBoost u v)

lemma toMatrix_mulVec (u v : FuturePointing d) (x : LorentzVector d) :
    (toMatrix u v).mulVec x = genBoost u v x

:=
  LinearMap.toMatrix_mulVec_repr LorentzVector.stdBasis LorentzVector.stdBasis (genBoost u v) x


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.NormOne
import HepLean.SpaceTime.LorentzGroup.Proper
/-!
# The Orthochronous Lorentz Group

We define the give a series of lemmas related to the orthochronous property of lorentz
matrices.

-/
/-! TODO: Prove topological properties of the Orthochronous Lorentz Group. -/

noncomputable section

open Matrix
open Complex
open ComplexConjugate

namespace LorentzGroup

variable {d : ℕ}
variable (Λ : LorentzGroup d)
open LorentzVector
open minkowskiMetric

/-- A Lorentz transformation is `orthochronous` if its `0 0` element is non-negative. -/
def IsOrthochronous : Prop := 0 ≤ timeComp Λ

lemma IsOrthochronous_iff_futurePointing :
    IsOrthochronous Λ ↔ (toNormOneLorentzVector Λ) ∈ NormOneLorentzVector.FuturePointing d := by
  simp only [IsOrthochronous, timeComp_eq_toNormOneLorentzVector]
  rw [NormOneLorentzVector.FuturePointing.mem_iff_time_nonneg]

lemma IsOrthochronous_iff_transpose :
    IsOrthochronous Λ ↔ IsOrthochronous (transpose Λ) := by rfl

lemma IsOrthochronous_iff_ge_one :
    IsOrthochronous Λ ↔ 1 ≤ timeComp Λ := by
  rw [IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.mem_iff,
    NormOneLorentzVector.time_pos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_neg_one :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ -1 := by
  rw [timeComp, IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.not_mem_iff,
    NormOneLorentzVector.time_nonpos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_zero :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · rw [not_orthochronous_iff_le_neg_one] at h
    linarith
  · rw [IsOrthochronous_iff_ge_one]
    linarith

/-- The continuous map taking a Lorentz transformation to its `0 0` element. -/
def timeCompCont : C(LorentzGroup d, ℝ) := ⟨fun Λ => timeComp Λ,
    Continuous.matrix_elem (continuous_iff_le_induced.mpr fun _ a => a) (Sum.inl 0) (Sum.inl 0)⟩

/-- An auxillary function used in the definition of `orthchroMapReal`. -/
def stepFunction : ℝ → ℝ := fun t =>
  if t ≤ -1 then -1 else
    if 1 ≤ t then 1 else t

lemma stepFunction_continuous : Continuous stepFunction := by
  apply Continuous.if ?_ continuous_const (Continuous.if ?_ continuous_const continuous_id)
    <;> intro a ha
  · rw [@Set.Iic_def, @frontier_Iic, @Set.mem_singleton_iff] at ha
    rw [ha]
    simp only [le_neg_self_iff, id_eq]
    have h1 : ¬ (1 : ℝ) ≤ 0 := by simp
    exact Eq.symm (if_neg h1)
  · rw [Set.Ici_def, @frontier_Ici, @Set.mem_singleton_iff] at ha
    exact id (Eq.symm ha)

/-- The continuous map from `lorentzGroup` to `ℝ` wh
taking Orthochronous elements to `1` and non-orthochronous to `-1`. -/
def orthchroMapReal : C(LorentzGroup d, ℝ) := ContinuousMap.comp
  ⟨stepFunction, stepFunction_continuous⟩ timeCompCont

lemma orthchroMapReal_on_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMapReal Λ = 1 := by
  rw [IsOrthochronous_iff_ge_one, timeComp] at h
  change stepFunction (Λ.1 _ _) = 1
  rw [stepFunction, if_pos h, if_neg]
  linarith

lemma orthchroMapReal_on_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMapReal Λ = - 1 := by
  rw [not_orthochronous_iff_le_neg_one] at h
  change stepFunction (timeComp _)= - 1
  rw [stepFunction, if_pos h]

lemma orthchroMapReal_minus_one_or_one (Λ : LorentzGroup d) :
    orthchroMapReal Λ = -1 ∨ orthchroMapReal Λ = 1 := by
  by_cases h : IsOrthochronous Λ
  · exact Or.inr $ orthchroMapReal_on_IsOrthochronous h
  · exact Or.inl $ orthchroMapReal_on_not_IsOrthochronous h

local notation "ℤ₂" => Multiplicative (ZMod 2)

/-- A continuous map from `lorentzGroup` to `ℤ₂` whose kernal are the Orthochronous elements. -/
def orthchroMap : C(LorentzGroup d, ℤ₂) :=
  ContinuousMap.comp coeForℤ₂ {
    toFun := fun Λ => ⟨orthchroMapReal Λ, orthchroMapReal_minus_one_or_one Λ⟩,
    continuous_toFun := Continuous.subtype_mk (ContinuousMap.continuous orthchroMapReal) _}

lemma orthchroMap_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMap Λ = 1 := by
  simp [orthchroMap, orthchroMapReal_on_IsOrthochronous h]

lemma orthchroMap_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMap Λ = Additive.toMul (1 : ZMod 2) := by
  simp only [orthchroMap, ContinuousMap.comp_apply, ContinuousMap.coe_mk,
    orthchroMapReal_on_not_IsOrthochronous h, coeForℤ₂_apply, Subtype.mk.injEq, Nat.reduceAdd]
  rw [if_neg]
  · rfl
  · linarith

lemma mul_othchron_of_othchron_othchron {Λ Λ' : LorentzGroup d} (h : IsOrthochronous Λ)
    (h' : IsOrthochronous Λ') : IsOrthochronous (Λ * Λ') := by
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  rw [IsOrthochronous, timeComp_mul]
  exact NormOneLorentzVector.FuturePointing.metric_reflect_mem_mem h h'

lemma mul_othchron_of_not_othchron_not_othchron {Λ Λ' : LorentzGroup d} (h : ¬ IsOrthochronous Λ)
    (h' : ¬ IsOrthochronous Λ') : IsOrthochronous (Λ * Λ') := by
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  rw [IsOrthochronous, timeComp_mul]
  exact NormOneLorentzVector.FuturePointing.metric_reflect_not_mem_not_mem h h'

lemma mul_not_othchron_of_othchron_not_othchron {Λ Λ' : LorentzGroup d} (h : IsOrthochronous Λ)
    (h' : ¬ IsOrthochronous Λ') : ¬ IsOrthochronous (Λ * Λ')

:= by
  rw [not_orthochronous_iff_le_zero, timeComp_mul]
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  exact NormOneLorentzVector.FuturePointing.metric_reflect_mem_not_mem h h'


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import Mathlib.Algebra.Lie.Classical
/-!

# The Minkowski Metric

This file introduces the Minkowski metric on spacetime in the mainly-minus signature.

We define the Minkowski metric as a bilinear map on the vector space
of Lorentz vectors in d dimensions.

-/

open Matrix BigOperators

/-!

# The definition of the Minkowski Matrix

-/
/-- The `d.succ`-dimensional real matrix of the form `diag(1, -1, -1, -1, ...)`. -/
def minkowskiMatrix {d : ℕ} : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LieAlgebra.Orthogonal.indefiniteDiagonal (Fin 1) (Fin d) ℝ

namespace minkowskiMatrix

variable {d : ℕ}

/-- Notation for `minkowskiMatrix`. -/
scoped[minkowskiMatrix] notation "η" => minkowskiMatrix

@[simp]
lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal]
  ext1 i j
  rcases i with i | i <;> rcases j with j | j
  · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne]
  · rfl
  · rfl
  · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne]

@[simp]
lemma eq_transpose : minkowskiMatrixᵀ = @minkowskiMatrix d := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_transpose]

@[simp]
lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by
  simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

@[simp]
lemma η_apply_mul_η_apply_diag (μ : Fin 1 ⊕ Fin d) : η μ μ * η μ μ = 1 := by
  match μ with
  | Sum.inl _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  | Sum.inr _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

lemma as_block : @minkowskiMatrix d = (
    Matrix.fromBlocks (1 : Matrix (Fin 1) (Fin 1) ℝ) 0 0 (-1 : Matrix (Fin d) (Fin d) ℝ)) := by
  rw [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, ← fromBlocks_diagonal]
  refine fromBlocks_inj.mpr ?_
  simp only [diagonal_one, true_and]
  funext i j
  rw [← diagonal_neg]
  rfl

@[simp]
lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  exact diagonal_apply_ne _ h

end minkowskiMatrix

/-!

# The definition of the Minkowski Metric

-/

/-- Given a Lorentz vector `v` we define the the linear map `w ↦ v * η * w`. -/
@[simps!]
def minkowskiLinearForm {d : ℕ} (v : LorentzVector d) : LorentzVector d →ₗ[ℝ] ℝ where
  toFun w := v ⬝ᵥ (minkowskiMatrix *ᵥ w)
  map_add' y z := by
    noncomm_ring
    rw [mulVec_add, dotProduct_add]
  map_smul' c y := by
    simp only [RingHom.id_apply, smul_eq_mul]
    rw [mulVec_smul, dotProduct_smul]
    rfl

/-- The Minkowski metric as a bilinear map. -/
def minkowskiMetric {d : ℕ} : LorentzVector d →ₗ[ℝ] LorentzVector d →ₗ[ℝ] ℝ where
  toFun v := minkowskiLinearForm v
  map_add' y z := by
    ext1 x
    simp only [minkowskiLinearForm_apply, LinearMap.add_apply]
    apply add_dotProduct
  map_smul' c y := by
    ext1 x
    simp only [minkowskiLinearForm_apply, RingHom.id_apply, LinearMap.smul_apply, smul_eq_mul]
    rw [smul_dotProduct]
    rfl

namespace minkowskiMetric

open minkowskiMatrix

open LorentzVector

variable {d : ℕ}
variable (v w : LorentzVector d)

/-- Notation for `minkowskiMetric`. -/
scoped[minkowskiMetric] notation:102 "⟪" v "," w "⟫ₘ" => minkowskiMetric v w
/-!

# Equalitites involving the Minkowski metric

-/

/-- The Minkowski metric expressed as a sum. -/
lemma as_sum :
    ⟪v, w⟫ₘ = v.time * w.time - ∑ i, v.space i * w.space i := by
  simp only [minkowskiMetric, LinearMap.coe_mk, AddHom.coe_mk, minkowskiLinearForm_apply,
    dotProduct, LieAlgebra.Orthogonal.indefiniteDiagonal, mulVec_diagonal, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Sum.elim_inl, one_mul,
    Finset.sum_singleton, Sum.elim_inr, neg_mul, mul_neg, Finset.sum_neg_distrib, time, space,
    Function.comp_apply, minkowskiMatrix]
  rfl

/-- The Minkowski metric expressed as a sum for a single vector. -/
lemma as_sum_self : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

lemma eq_time_minus_inner_prod : ⟪v, w⟫ₘ = v.time * w.time - ⟪v.space, w.space⟫_ℝ := by
  rw [as_sum, @PiLp.inner_apply]
  rfl

lemma self_eq_time_minus_norm : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

/-- The Minkowski metric is symmetric in its arguments.. -/
lemma symm : ⟪v, w⟫ₘ = ⟪w, v⟫ₘ := by
  simp only [as_sum]
  ac_rfl

lemma time_sq_eq_metric_add_space : v.time ^ 2 = ⟪v, v⟫ₘ + ‖v.space‖ ^ 2 := by
  rw [self_eq_time_minus_norm]
  exact Eq.symm (sub_add_cancel (v.time ^ 2) (‖v.space‖ ^ 2))

/-!

# Minkowski metric and space reflections

-/

lemma right_spaceReflection : ⟪v, w.spaceReflection⟫ₘ = v.time * w.time + ⟪v.space, w.space⟫_ℝ := by
  rw [eq_time_minus_inner_prod, spaceReflection_space, spaceReflection_time]
  simp only [time, Fin.isValue, space, inner_neg_right, PiLp.inner_apply, Function.comp_apply,
    RCLike.inner_apply, conj_trivial, sub_neg_eq_add]

lemma self_spaceReflection_eq_zero_iff : ⟪v, v.spaceReflection⟫ₘ = 0 ↔ v = 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · rw [right_spaceReflection] at h
    have h2 : 0 ≤ ⟪v.space, v.space⟫_ℝ := real_inner_self_nonneg
    have h3 : v.time * v.time = 0 := by linarith [mul_self_nonneg v.time]
    have h4 : ⟪v.space, v.space⟫_ℝ = 0 := by linarith
    simp only [time, Fin.isValue, mul_eq_zero, or_self] at h3
    rw [@inner_self_eq_zero] at h4
    funext i
    rcases i with i | i
    · fin_cases i
      exact h3
    · simpa using congrFun h4 i
  · rw [h]
    exact LinearMap.map_zero₂ minkowskiMetric (spaceReflection 0)

/-!

# Non degeneracy of the Minkowski metric

-/

/-- The metric tensor is non-degenerate. -/
lemma nondegenerate : (∀ w, ⟪w, v⟫ₘ = 0) ↔ v = 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · exact (self_spaceReflection_eq_zero_iff _).mp ((symm _ _).trans $ h v.spaceReflection)
  · simp [h]

/-!

# Inequalities involving the Minkowski metric

-/

lemma leq_time_sq : ⟪v, v⟫ₘ ≤ v.time ^ 2 := by
  rw [time_sq_eq_metric_add_space]
  exact (le_add_iff_nonneg_right _).mpr $ sq_nonneg ‖v.space‖

lemma ge_abs_inner_product : v.time * w.time - ‖⟪v.space, w.space⟫_ℝ‖ ≤ ⟪v, w⟫ₘ

:= by
  rw [eq_time_minus_inner_prod, sub_le_sub_iff_left]
  exact Real.le_norm_self ⟪v.space, w.space⟫_ℝ


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import Mathlib.Data.Complex.Exponential
import Mathlib.Geometry.Manifold.SmoothManifoldWithCorners
import Mathlib.Analysis.InnerProductSpace.PiL2
/-!
# Space time

This file introduce 4d Minkowski spacetime.

-/

noncomputable section

/-- The space-time -/
def SpaceTime : Type := Fin 4 → ℝ

/-- Give spacetime the structure of an additive commutative monoid. -/
instance : AddCommMonoid SpaceTime := Pi.addCommMonoid

/-- Give spacetime the structure of a module over the reals. -/
instance : Module ℝ SpaceTime := Pi.module _ _ _

instance euclideanNormedAddCommGroup : NormedAddCommGroup SpaceTime := Pi.normedAddCommGroup

instance euclideanNormedSpace : NormedSpace ℝ SpaceTime := Pi.normedSpace
namespace SpaceTime

open Manifold
open Matrix
open Complex
open ComplexConjugate

/-- The space part of spacetime. -/
@[simp]
def space (x : SpaceTime) : EuclideanSpace ℝ (Fin 3) := ![x 1, x 2, x 3]

/-- The structure of a smooth manifold on spacetime. -/
def asSmoothManifold : ModelWithCorners ℝ SpaceTime SpaceTime := 𝓘(ℝ, SpaceTime)

instance : ChartedSpace SpaceTime SpaceTime := chartedSpaceSelf SpaceTime

/-- The standard basis for spacetime. -/
def stdBasis : Basis (Fin 4) ℝ SpaceTime := Pi.basisFun ℝ (Fin 4)

lemma stdBasis_apply (μ ν : Fin 4) : stdBasis μ ν = if μ = ν then 1 else 0 := by
  erw [stdBasis, Pi.basisFun_apply, LinearMap.stdBasis_apply']

lemma stdBasis_not_eq {μ ν : Fin 4} (h : μ ≠ ν) : stdBasis μ ν = 0 := by
  rw [stdBasis_apply]
  exact if_neg h

lemma stdBasis_0 : stdBasis 0 = ![1, 0, 0, 0] := by
  funext i
  fin_cases i <;> simp [stdBasis_apply]

lemma stdBasis_1 : stdBasis 1 = ![0, 1, 0, 0] := by
  funext i
  fin_cases i <;> simp [stdBasis_apply]

lemma stdBasis_2 : stdBasis 2 = ![0, 0, 1, 0] := by
  funext i
  fin_cases i <;> simp [stdBasis_apply]

lemma stdBasis_3 : stdBasis 3 = ![0, 0, 0, 1] := by
  funext i
  fin_cases i <;> simp [stdBasis_apply]

lemma stdBasis_mulVec (μ ν : Fin 4) (Λ : Matrix (Fin 4) (Fin 4) ℝ) :
    (Λ *ᵥ stdBasis μ) ν = Λ ν μ := by
  rw [mulVec, dotProduct, Fintype.sum_eq_single μ, stdBasis_apply]
  · simp only [↓reduceIte, mul_one]
  · intro x h
    rw [stdBasis_apply, if_neg (Ne.symm h)]
    exact CommMonoidWithZero.mul_zero (Λ ν x)

lemma explicit (x : SpaceTime) : x = ![x 0, x 1, x 2, x 3] := by
  funext i
  fin_cases i <;> rfl

@[simp]
lemma add_apply (x y : SpaceTime) (i : Fin 4) : (x + y) i = x i + y i := rfl

@[simp]
lemma smul_apply (x : SpaceTime) (a : ℝ) (i : Fin 4) : (a • x) i = a * x i


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzGroup.Basic
/-!
# The Proper Lorentz Group

The proper Lorentz group is the subgroup of the Lorentz group with determinant `1`.

We define the give a series of lemmas related to the determinant of the Lorentz group.

-/

noncomputable section

open Matrix
open Complex
open ComplexConjugate

namespace LorentzGroup

open minkowskiMetric

variable {d : ℕ}

/-- The determinant of a member of the Lorentz group is `1` or `-1`. -/
lemma det_eq_one_or_neg_one (Λ : 𝓛 d) : Λ.1.det = 1 ∨ Λ.1.det = -1 := by
  refine mul_self_eq_one_iff.mp ?_
  simpa only [det_mul, det_dual, det_one] using congrArg det ((mem_iff_self_mul_dual).mp Λ.2)

local notation "ℤ₂" => Multiplicative (ZMod 2)

instance : TopologicalSpace ℤ₂ := instTopologicalSpaceFin

instance : DiscreteTopology ℤ₂ := by
  exact forall_open_iff_discrete.mp fun _ => trivial

instance : TopologicalGroup ℤ₂ := TopologicalGroup.mk

instance _root_.Finite.instDiscreteTopology [TopologicalSpace X] [T1Space X] [Finite X] : DiscreteTopology X :=
  discreteTopology_iff_forall_isClosed.mpr (· |>.toFinite.isClosed)

/-- A continuous function from `({-1, 1} : Set ℝ)` to `ℤ₂`. -/
@[simps!]
def coeForℤ₂ : C(({-1, 1} : Set ℝ), ℤ₂) where
  toFun x := if x = ⟨1, Set.mem_insert_of_mem (-1) rfl⟩
    then Additive.toMul 0 else Additive.toMul (1 : ZMod 2)
  continuous_toFun := continuous_of_discreteTopology

/-- The continuous map taking a Lorentz matrix to its determinant. -/
def detContinuous : C(𝓛 d, ℤ₂) :=
  ContinuousMap.comp coeForℤ₂ {
    toFun := fun Λ => ⟨Λ.1.det, Or.symm (LorentzGroup.det_eq_one_or_neg_one _)⟩,
    continuous_toFun := by
      refine Continuous.subtype_mk ?_ _
      exact Continuous.matrix_det $
        Continuous.comp' (continuous_iff_le_induced.mpr fun U a => a) continuous_id'
      }

@[simp]
lemma _root_.toMul_eq_one {α : Type*} [One α] {x : Additive α} :
    Additive.toMul x = 1 ↔ x = 0


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.LorentzAction
import HepLean.SpaceTime.LorentzVector.Covariant
import HepLean.Tensors.Basic
/-!

# Contractions of Lorentz vectors

We define the contraction between a covariant and contravariant Lorentz vector,
as well as properties thereof.

The structures in this file are used in `HepLean.SpaceTime.LorentzTensor.Real.Basic`
to define the contraction between indices of Lorentz tensors.

-/

noncomputable section

open TensorProduct BigOperators

namespace LorentzVector

open Matrix
variable {d : ℕ} (v : LorentzVector d)

/-- The bi-linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDownBi : LorentzVector d →ₗ[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ where
  toFun v := {
    toFun := fun w => ∑ i, v i * w i,
    map_add' := by
      intro w1 w2
      rw [← Finset.sum_add_distrib]
      refine Finset.sum_congr rfl (fun i _ => mul_add _ _ _)
    map_smul' := by
      intro r w
      simp only [RingHom.id_apply, smul_eq_mul]
      rw [Finset.mul_sum]
      refine Finset.sum_congr rfl (fun i _ => ?_)
      simp only [HSMul.hSMul, SMul.smul]
      ring}
  map_add' v1 v2 := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply]
    rw [← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl (fun i _ => add_mul _ _ _)
  map_smul' r v := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.smul_apply]
    rw [Finset.smul_sum]
    refine Finset.sum_congr rfl (fun i _ => ?_)
    simp only [HSMul.hSMul, SMul.smul]
    exact mul_assoc r (v i) (w i)

/-- The linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ :=
  TensorProduct.lift contrUpDownBi

lemma contrUpDown_tmul_eq_dotProduct {x : LorentzVector d} {y : CovariantLorentzVector d} :
    contrUpDown (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rfl

@[simp]
lemma contrUpDown_stdBasis_left (x : LorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (x ⊗ₜ[ℝ] (CovariantLorentzVector.stdBasis i)) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · simp only [CovariantLorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    apply Or.inr hbi.symm

@[simp]
lemma contrUpDown_stdBasis_right (x : CovariantLorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (e i ⊗ₜ[ℝ] x) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, one_mul]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    left
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    exact hbi.symm

/-- The linear map defining the contraction of a covariant Lorentz vector
  and a contravariant Lorentz vector. -/
def contrDownUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d →ₗ[ℝ] ℝ :=
  contrUpDown ∘ₗ (TensorProduct.comm ℝ _ _).toLinearMap

lemma contrDownUp_tmul_eq_dotProduct {x : CovariantLorentzVector d} {y : LorentzVector d} :
    contrDownUp (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.LorentzAction
import HepLean.SpaceTime.LorentzVector.Covariant
import HepLean.Tensors.Basic
/-!

# Contractions of Lorentz vectors

We define the contraction between a covariant and contravariant Lorentz vector,
as well as properties thereof.

The structures in this file are used in `HepLean.SpaceTime.LorentzTensor.Real.Basic`
to define the contraction between indices of Lorentz tensors.

-/

noncomputable section

open TensorProduct BigOperators

namespace LorentzVector

open Matrix
variable {d : ℕ} (v : LorentzVector d)

/-- The bi-linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDownBi : LorentzVector d →ₗ[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ where
  toFun v := {
    toFun := fun w => ∑ i, v i * w i,
    map_add' := by
      intro w1 w2
      rw [← Finset.sum_add_distrib]
      refine Finset.sum_congr rfl (fun i _ => mul_add _ _ _)
    map_smul' := by
      intro r w
      simp only [RingHom.id_apply, smul_eq_mul]
      rw [Finset.mul_sum]
      refine Finset.sum_congr rfl (fun i _ => ?_)
      simp only [HSMul.hSMul, SMul.smul]
      ring}
  map_add' v1 v2 := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply]
    rw [← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl (fun i _ => add_mul _ _ _)
  map_smul' r v := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.smul_apply]
    rw [Finset.smul_sum]
    refine Finset.sum_congr rfl (fun i _ => ?_)
    simp only [HSMul.hSMul, SMul.smul]
    exact mul_assoc r (v i) (w i)

/-- The linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ :=
  TensorProduct.lift contrUpDownBi

lemma contrUpDown_tmul_eq_dotProduct {x : LorentzVector d} {y : CovariantLorentzVector d} :
    contrUpDown (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rfl

@[simp]
lemma contrUpDown_stdBasis_left (x : LorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (x ⊗ₜ[ℝ] (CovariantLorentzVector.stdBasis i)) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · simp only [CovariantLorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    apply Or.inr hbi.symm

@[simp]
lemma contrUpDown_stdBasis_right (x : CovariantLorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (e i ⊗ₜ[ℝ] x) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, one_mul]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    left
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    exact hbi.symm

/-- The linear map defining the contraction of a covariant Lorentz vector
  and a contravariant Lorentz vector. -/
def contrDownUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d →ₗ[ℝ] ℝ :=
  contrUpDown ∘ₗ (TensorProduct.comm ℝ _ _).toLinearMap

lemma contrDownUp_tmul_eq_dotProduct {x : CovariantLorentzVector d} {y : LorentzVector d} :
    contrDownUp (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rw [dotProduct_comm x y]
  rfl

/-!

## The unit of the contraction

-/

/-- The unit of the contraction of contravariant Lorentz vector and a
  covariant Lorentz vector. -/
def unitUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ i, CovariantLorentzVector.stdBasis i ⊗ₜ[ℝ] LorentzVector.stdBasis i

lemma unitUp_rid (x : LorentzVector d) :
    TensorStructure.contrLeftAux contrUpDown (x ⊗ₜ[ℝ] unitUp) = x := by
  simp only [unitUp, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, LinearEquiv.refl_toLinearMap, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, map_add,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul, map_sum, decomp_stdBasis']

/-- The unit of the contraction of covariant Lorentz vector and a
  contravariant Lorentz vector. -/
def unitDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ i, LorentzVector.stdBasis i ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis i

lemma unitDown_rid (x : CovariantLorentzVector d) :
    TensorStructure.contrLeftAux contrDownUp (x ⊗ₜ[ℝ] unitDown) = x := by
  simp only [unitDown, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap,
    Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply,
    assoc_symm_tmul, map_tmul, comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq,
    lid_tmul, map_sum, CovariantLorentzVector.decomp_stdBasis']

/-!

# Contractions and the Lorentz actions

-/
open Matrix

@[simp]
lemma contrUpDown_invariant_lorentzAction : @contrUpDown d ((LorentzVector.rep g) x ⊗ₜ[ℝ]
    (CovariantLorentzVector.rep g) y) = contrUpDown (x ⊗ₜ[ℝ] y) := by
  rw [contrUpDown_tmul_eq_dotProduct, contrUpDown_tmul_eq_dotProduct]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

@[simp]
lemma contrDownUp_invariant_lorentzAction : @contrDownUp d ((CovariantLorentzVector.rep g) x ⊗ₜ[ℝ]
    (LorentzVector.rep g) y) = contrDownUp (x ⊗ₜ[ℝ] y) := by
  rw [contrDownUp_tmul_eq_dotProduct, contrDownUp_tmul_eq_dotProduct]
  rw [dotProduct_comm, dotProduct_comm x y]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

end LorentzVector

namespace minkowskiMatrix
open LorentzVector
open TensorStructure
open scoped minkowskiMatrix
variable {d : ℕ}

/-- The metric tensor as an element of `LorentzVector d ⊗[ℝ] LorentzVector d`. -/
def asTenProd : LorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis ν)

lemma asTenProd_diag :
    @asTenProd d = ∑ μ, η μ μ • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis μ) := by
  simp only [asTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    exact TensorProduct.zero_smul (e μ ⊗ₜ[ℝ] e ν)
  · intro a
    rename_i j
    exact False.elim (a j)

/-- The metric tensor as an element of `CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d`. -/
def asCoTenProd : CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis ν)

lemma asCoTenProd_diag :
    @asCoTenProd d = ∑ μ, η μ μ • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ]
      CovariantLorentzVector.stdBasis μ) := by
  simp only [asCoTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    simp only [zero_smul]
  · intro a
    simp_all only

@[simp]
lemma contrLeft_asTenProd (x : CovariantLorentzVector d) :
    contrLeftAux contrDownUp (x ⊗ₜ[ℝ] asTenProd) =
    ∑ μ, ((η μ μ * x μ) • LorentzVector.stdBasis μ) := by
  simp only [asTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (e μ)

@[simp]
lemma contrLeft_asCoTenProd (x : LorentzVector d) :
    contrLeftAux contrUpDown (x ⊗ₜ[ℝ] asCoTenProd) =
    ∑ μ, ((η μ μ * x μ) • CovariantLorentzVector.stdBasis μ) := by
  simp only [asCoTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (CovariantLorentzVector.stdBasis μ)

@[simp]
lemma asTenProd_contr_asCoTenProd :
    (contrMidAux (contrUpDown) (asTenProd ⊗ₜ[ℝ] asCoTenProd))
    = TensorProduct.comm ℝ _ _ (@unitUp d) := by
  simp only [contrMidAux, LinearEquiv.refl_toLinearMap, asTenProd_diag, LinearMap.coe_comp,
    LinearEquiv.coe_coe, Function.comp_apply]
  rw [sum_tmul, map_sum, map_sum, unitUp]
  simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, comm_tmul, map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [← tmul_smul, TensorProduct.assoc_tmul]
  simp only [map_tmul, LinearMap.id_coe, id_eq, contrLeft_asCoTenProd]
  rw [tmul_sum, Finset.sum_eq_single_of_mem μ, tmul_smul]
  · change (η μ μ * (η μ μ * e μ μ)) • e μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis μ = _
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one, η_apply_mul_η_apply_diag, one_smul]
  · exact Finset.mem_univ μ
  · intro ν _ hμν
    rw [tmul_smul]
    change (η ν ν * (η μ μ * e μ ν)) • (e μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis ν) = _
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', mul_ite, mul_one, mul_zero, ite_smul, zero_smul,
      ite_eq_right_iff, smul_eq_zero, mul_eq_zero]
    exact fun a => False.elim (hμν a.symm)

@[simp]
lemma asCoTenProd_contr_asTenProd :
    (contrMidAux (contrDownUp) (asCoTenProd ⊗ₜ[ℝ] asTenProd))
    = TensorProduct.comm ℝ _ _ (@unitDown d) := by
  simp only [contrMidAux, LinearEquiv.refl_toLinearMap, asCoTenProd_diag,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply]
  rw [sum_tmul, map_sum, map_sum, unitDown]
  simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, comm_tmul, map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [smul_tmul, TensorProduct.assoc_tmul]
  simp only [tmul_smul, map_smul, map_tmul, LinearMap.id_coe, id_eq,
    contrLeft_asTenProd]
  rw [tmul_sum, Finset.sum_eq_single_of_mem μ, tmul_smul, smul_smul, LorentzVector.stdBasis]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one, η_apply_mul_η_apply_diag, one_smul]
  · exact Finset.mem_univ μ
  · intro ν _ hμν
    rw [tmul_smul]
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', mul_ite, mul_one, mul_zero, ite_smul, zero_smul,
      ite_eq_right_iff, smul_eq_zero]
    exact fun a => False.elim (hμν a.symm)

lemma asTenProd_invariant (g : LorentzGroup d) :
    TensorProduct.map (LorentzVector.rep g) (LorentzVector.rep g) asTenProd = asTenProd

:= by
  simp only [asTenProd, map_sum, map_smul, map_tmul, rep_apply_stdBasis,
    Matrix.transpose_apply]
  trans ∑ μ : Fin 1 ⊕ Fin d, ∑ ν : Fin 1 ⊕ Fin d, ∑ φ : Fin 1 ⊕ Fin d,
      η μ ν • (g.1 φ μ • e φ) ⊗ₜ[ℝ] ∑ ρ : Fin 1 ⊕ Fin d, g.1 ρ ν • e ρ
  · refine Finset.sum_congr rfl (fun μ _ => Finset.sum_congr rfl (fun ν _ => ?_))
    rw [sum_tmul, Finset.smul_sum]
  trans ∑ μ : Fin 1 ⊕ Fin d, ∑ ν : Fin 1 ⊕ Fin d, ∑ φ : Fin 1 ⊕ Fin d, ∑ ρ : Fin 1 ⊕ Fin d,
      (η μ ν • (g.1 φ μ • e φ) ⊗ₜ[ℝ] (g.1 ρ ν • e ρ))
  · refine Finset.sum_congr rfl (fun μ _ => Finset.sum_congr rfl (fun ν _ =>
      Finset.sum_congr rfl (fun φ _ => ?_)))
    rw [tmul_sum, Finset.smul_sum]
  rw [Finset.sum_congr rfl (fun μ _ => Finset.sum_comm)]
  rw [Finset.sum_congr rfl (fun μ _ => Finset.sum_congr rfl (fun ν _ => Finset.sum_comm))]
  rw [Finset.sum_comm]
  rw [Finset.sum_congr rfl (fun φ _ => Finset.sum_comm)]
  trans ∑ φ : Fin 1 ⊕ Fin d, ∑ ρ : Fin 1 ⊕ Fin d, ∑ μ : Fin 1 ⊕ Fin d, ∑ ν : Fin 1 ⊕ Fin d,
      ((g.1 φ μ * η μ ν * g.1 ρ ν) • (e φ) ⊗ₜ[ℝ] (e ρ))
  · refine Finset.sum_congr rfl (fun φ _ => Finset.sum_congr rfl (fun ρ _ =>
    Finset.sum_congr rfl (fun μ _ => Finset.sum_congr rfl (fun ν _ => ?_))))
    rw [smul_tmul, tmul_smul, tmul_smul, smul_smul, smul_smul]
    ring_nf
  rw [Finset.sum_congr rfl (fun φ _ => Finset.sum_congr rfl (fun ρ _ =>
    Finset.sum_congr rfl (fun μ _ => Finset.sum_smul.symm)))]
  rw [Finset.sum_congr rfl (fun φ _ => Finset.sum_congr rfl (fun ρ _ => Finset.sum_smul.symm))]
  trans ∑ φ : Fin 1 ⊕ Fin d, ∑ ρ : Fin 1 ⊕ Fin d,
    (((g.1 * minkowskiMatrix * g.1.transpose : Matrix _ _ _) φ ρ) • (e φ) ⊗ₜ[ℝ] (e ρ))
  · refine Finset.sum_congr rfl (fun φ _ => Finset.sum_congr rfl (fun ρ _ => ?_))
    apply congrFun
    apply congrArg
    simp only [Matrix.mul_apply, Matrix.transpose_apply]
    rw [Finset.sum_comm]
    refine Finset.sum_congr rfl (fun μ _ => ?_)
    rw [Finset.sum_mul]
  simp


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import Mathlib.Algebra.Lie.Classical
/-!

# The Minkowski Metric

This file introduces the Minkowski metric on spacetime in the mainly-minus signature.

We define the Minkowski metric as a bilinear map on the vector space
of Lorentz vectors in d dimensions.

-/

open Matrix BigOperators

/-!

# The definition of the Minkowski Matrix

-/
/-- The `d.succ`-dimensional real matrix of the form `diag(1, -1, -1, -1, ...)`. -/
def minkowskiMatrix {d : ℕ} : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LieAlgebra.Orthogonal.indefiniteDiagonal (Fin 1) (Fin d) ℝ

namespace minkowskiMatrix

variable {d : ℕ}

/-- Notation for `minkowskiMatrix`. -/
scoped[minkowskiMatrix] notation "η" => minkowskiMatrix

@[simp]
lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal]
  ext1 i j
  rcases i with i | i <;> rcases j with j | j
  · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne]
  · rfl
  · rfl
  · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne]

@[simp]
lemma eq_transpose : minkowskiMatrixᵀ = @minkowskiMatrix d := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_transpose]

@[simp]
lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by
  simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

@[simp]
lemma η_apply_mul_η_apply_diag (μ : Fin 1 ⊕ Fin d) : η μ μ * η μ μ = 1 := by
  match μ with
  | Sum.inl _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  | Sum.inr _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

lemma as_block : @minkowskiMatrix d = (
    Matrix.fromBlocks (1 : Matrix (Fin 1) (Fin 1) ℝ) 0 0 (-1 : Matrix (Fin d) (Fin d) ℝ)) := by
  rw [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, ← fromBlocks_diagonal]
  refine fromBlocks_inj.mpr ?_
  simp only [diagonal_one, true_and]
  funext i j
  rw [← diagonal_neg]
  rfl

@[simp]
lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  exact diagonal_apply_ne _ h

end minkowskiMatrix

/-!

# The definition of the Minkowski Metric

-/

/-- Given a Lorentz vector `v` we define the the linear map `w ↦ v * η * w`. -/
@[simps!]
def minkowskiLinearForm {d : ℕ} (v : LorentzVector d) : LorentzVector d →ₗ[ℝ] ℝ where
  toFun w := v ⬝ᵥ (minkowskiMatrix *ᵥ w)
  map_add' y z := by
    noncomm_ring
    rw [mulVec_add, dotProduct_add]
  map_smul' c y := by
    simp only [RingHom.id_apply, smul_eq_mul]
    rw [mulVec_smul, dotProduct_smul]
    rfl

/-- The Minkowski metric as a bilinear map. -/
def minkowskiMetric {d : ℕ} : LorentzVector d →ₗ[ℝ] LorentzVector d →ₗ[ℝ] ℝ where
  toFun v := minkowskiLinearForm v
  map_add' y z := by
    ext1 x
    simp only [minkowskiLinearForm_apply, LinearMap.add_apply]
    apply add_dotProduct
  map_smul' c y := by
    ext1 x
    simp only [minkowskiLinearForm_apply, RingHom.id_apply, LinearMap.smul_apply, smul_eq_mul]
    rw [smul_dotProduct]
    rfl

namespace minkowskiMetric

open minkowskiMatrix

open LorentzVector

variable {d : ℕ}
variable (v w : LorentzVector d)

/-- Notation for `minkowskiMetric`. -/
scoped[minkowskiMetric] notation:102 "⟪" v "," w "⟫ₘ" => minkowskiMetric v w
/-!

# Equalitites involving the Minkowski metric

-/

/-- The Minkowski metric expressed as a sum. -/
lemma as_sum :
    ⟪v, w⟫ₘ = v.time * w.time - ∑ i, v.space i * w.space i := by
  simp only [minkowskiMetric, LinearMap.coe_mk, AddHom.coe_mk, minkowskiLinearForm_apply,
    dotProduct, LieAlgebra.Orthogonal.indefiniteDiagonal, mulVec_diagonal, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Sum.elim_inl, one_mul,
    Finset.sum_singleton, Sum.elim_inr, neg_mul, mul_neg, Finset.sum_neg_distrib, time, space,
    Function.comp_apply, minkowskiMatrix]
  rfl

/-- The Minkowski metric expressed as a sum for a single vector. -/
lemma as_sum_self : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

lemma eq_time_minus_inner_prod : ⟪v, w⟫ₘ = v.time * w.time - ⟪v.space, w.space⟫_ℝ

:= by
  rw [as_sum, @PiLp.inner_apply]
  rfl


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import Mathlib.Algebra.Lie.Classical
/-!

# The Minkowski Metric

This file introduces the Minkowski metric on spacetime in the mainly-minus signature.

We define the Minkowski metric as a bilinear map on the vector space
of Lorentz vectors in d dimensions.

-/

open Matrix BigOperators

/-!

# The definition of the Minkowski Matrix

-/
/-- The `d.succ`-dimensional real matrix of the form `diag(1, -1, -1, -1, ...)`. -/
def minkowskiMatrix {d : ℕ} : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ :=
  LieAlgebra.Orthogonal.indefiniteDiagonal (Fin 1) (Fin d) ℝ

namespace minkowskiMatrix

variable {d : ℕ}

/-- Notation for `minkowskiMatrix`. -/
scoped[minkowskiMatrix] notation "η" => minkowskiMatrix

@[simp]
lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal]
  ext1 i j
  rcases i with i | i <;> rcases j with j | j
  · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne]
  · rfl
  · rfl
  · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg]
    split
    · rename_i h
      subst h
      simp_all only [one_apply_eq]
    · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne]

@[simp]
lemma eq_transpose : minkowskiMatrixᵀ = @minkowskiMatrix d := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_transpose]

@[simp]
lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by
  simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

@[simp]
lemma η_apply_mul_η_apply_diag (μ : Fin 1 ⊕ Fin d) : η μ μ * η μ μ = 1 := by
  match μ with
  | Sum.inl _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  | Sum.inr _ => simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]

lemma as_block : @minkowskiMatrix d = (
    Matrix.fromBlocks (1 : Matrix (Fin 1) (Fin 1) ℝ) 0 0 (-1 : Matrix (Fin d) (Fin d) ℝ)) := by
  rw [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, ← fromBlocks_diagonal]
  refine fromBlocks_inj.mpr ?_
  simp only [diagonal_one, true_and]
  funext i j
  rw [← diagonal_neg]
  rfl

@[simp]
lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := by
  simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal]
  exact diagonal_apply_ne _ h

end minkowskiMatrix

/-!

# The definition of the Minkowski Metric

-/

/-- Given a Lorentz vector `v` we define the the linear map `w ↦ v * η * w`. -/
@[simps!]
def minkowskiLinearForm {d : ℕ} (v : LorentzVector d) : LorentzVector d →ₗ[ℝ] ℝ where
  toFun w := v ⬝ᵥ (minkowskiMatrix *ᵥ w)
  map_add' y z := by
    noncomm_ring
    rw [mulVec_add, dotProduct_add]
  map_smul' c y := by
    simp only [RingHom.id_apply, smul_eq_mul]
    rw [mulVec_smul, dotProduct_smul]
    rfl

/-- The Minkowski metric as a bilinear map. -/
def minkowskiMetric {d : ℕ} : LorentzVector d →ₗ[ℝ] LorentzVector d →ₗ[ℝ] ℝ where
  toFun v := minkowskiLinearForm v
  map_add' y z := by
    ext1 x
    simp only [minkowskiLinearForm_apply, LinearMap.add_apply]
    apply add_dotProduct
  map_smul' c y := by
    ext1 x
    simp only [minkowskiLinearForm_apply, RingHom.id_apply, LinearMap.smul_apply, smul_eq_mul]
    rw [smul_dotProduct]
    rfl

namespace minkowskiMetric

open minkowskiMatrix

open LorentzVector

variable {d : ℕ}
variable (v w : LorentzVector d)

/-- Notation for `minkowskiMetric`. -/
scoped[minkowskiMetric] notation:102 "⟪" v "," w "⟫ₘ" => minkowskiMetric v w
/-!

# Equalitites involving the Minkowski metric

-/

/-- The Minkowski metric expressed as a sum. -/
lemma as_sum :
    ⟪v, w⟫ₘ = v.time * w.time - ∑ i, v.space i * w.space i := by
  simp only [minkowskiMetric, LinearMap.coe_mk, AddHom.coe_mk, minkowskiLinearForm_apply,
    dotProduct, LieAlgebra.Orthogonal.indefiniteDiagonal, mulVec_diagonal, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Sum.elim_inl, one_mul,
    Finset.sum_singleton, Sum.elim_inr, neg_mul, mul_neg, Finset.sum_neg_distrib, time, space,
    Function.comp_apply, minkowskiMatrix]
  rfl

/-- The Minkowski metric expressed as a sum for a single vector. -/
lemma as_sum_self : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

lemma eq_time_minus_inner_prod : ⟪v, w⟫ₘ = v.time * w.time - ⟪v.space, w.space⟫_ℝ := by
  rw [as_sum, @PiLp.inner_apply]
  rfl

lemma self_eq_time_minus_norm : ⟪v, v⟫ₘ = v.time ^ 2 - ‖v.space‖ ^ 2 := by
  rw [← real_inner_self_eq_norm_sq, PiLp.inner_apply, as_sum]
  noncomm_ring

/-- The Minkowski metric is symmetric in its arguments.. -/
lemma symm : ⟪v, w⟫ₘ = ⟪w, v⟫ₘ := by
  simp only [as_sum]
  ac_rfl

lemma time_sq_eq_metric_add_space : v.time ^ 2 = ⟪v, v⟫ₘ + ‖v.space‖ ^ 2 := by
  rw [self_eq_time_minus_norm]
  exact Eq.symm (sub_add_cancel (v.time ^ 2) (‖v.space‖ ^ 2))

/-!

# Minkowski metric and space reflections

-/

lemma right_spaceReflection : ⟪v, w.spaceReflection⟫ₘ = v.time * w.time + ⟪v.space, w.space⟫_ℝ := by
  rw [eq_time_minus_inner_prod, spaceReflection_space, spaceReflection_time]
  simp only [time, Fin.isValue, space, inner_neg_right, PiLp.inner_apply, Function.comp_apply,
    RCLike.inner_apply, conj_trivial, sub_neg_eq_add]

lemma self_spaceReflection_eq_zero_iff : ⟪v, v.spaceReflection⟫ₘ = 0 ↔ v = 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · rw [right_spaceReflection] at h
    have h2 : 0 ≤ ⟪v.space, v.space⟫_ℝ := real_inner_self_nonneg
    have h3 : v.time * v.time = 0 := by linarith [mul_self_nonneg v.time]
    have h4 : ⟪v.space, v.space⟫_ℝ = 0 := by linarith
    simp only [time, Fin.isValue, mul_eq_zero, or_self] at h3
    rw [@inner_self_eq_zero] at h4
    funext i
    rcases i with i | i
    · fin_cases i
      exact h3
    · simpa using congrFun h4 i
  · rw [h]
    exact LinearMap.map_zero₂ minkowskiMetric (spaceReflection 0)

/-!

# Non degeneracy of the Minkowski metric

-/

/-- The metric tensor is non-degenerate. -/
lemma nondegenerate : (∀ w, ⟪w, v⟫ₘ = 0) ↔ v = 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · exact (self_spaceReflection_eq_zero_iff _).mp ((symm _ _).trans $ h v.spaceReflection)
  · simp [h]

/-!

# Inequalities involving the Minkowski metric

-/

lemma leq_time_sq : ⟪v, v⟫ₘ ≤ v.time ^ 2 := by
  rw [time_sq_eq_metric_add_space]
  exact (le_add_iff_nonneg_right _).mpr $ sq_nonneg ‖v.space‖

lemma ge_abs_inner_product : v.time * w.time - ‖⟪v.space, w.space⟫_ℝ‖ ≤ ⟪v, w⟫ₘ := by
  rw [eq_time_minus_inner_prod, sub_le_sub_iff_left]
  exact Real.le_norm_self ⟪v.space, w.space⟫_ℝ

lemma ge_sub_norm : v.time * w.time - ‖v.space‖ * ‖w.space‖ ≤ ⟪v, w⟫ₘ := by
  apply le_trans _ (ge_abs_inner_product v w)
  rw [sub_le_sub_iff_left]
  exact norm_inner_le_norm v.space w.space

/-!

# The Minkowski metric and matrices

-/
section matrices

variable (Λ Λ' : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ)

/-- The dual of a matrix with respect to the Minkowski metric. -/
def dual : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ := η * Λᵀ * η

@[simp]
lemma dual_id : @dual d 1 = 1 := by
  simpa only [dual, transpose_one, mul_one] using minkowskiMatrix.sq

@[simp]
lemma dual_mul : dual (Λ * Λ') = dual Λ' * dual Λ := by
  simp only [dual, transpose_mul]
  trans η * Λ'ᵀ * (η * η) * Λᵀ * η
  · noncomm_ring [minkowskiMatrix.sq]
  · noncomm_ring

@[simp]
lemma dual_dual : dual (dual Λ) = Λ := by
  simp only [dual, transpose_mul, transpose_transpose, eq_transpose]
  trans (η * η) * Λ * (η * η)
  · noncomm_ring
  · noncomm_ring [minkowskiMatrix.sq]

@[simp]
lemma dual_eta : @dual d η = η := by
  simp only [dual, eq_transpose]
  noncomm_ring [minkowskiMatrix.sq]

@[simp]
lemma dual_transpose : dual Λᵀ = (dual Λ)ᵀ := by
  simp only [dual, transpose_transpose, transpose_mul, eq_transpose]
  noncomm_ring

@[simp]
lemma det_dual : (dual Λ).det = Λ.det

:= by
  simp only [dual, det_mul, minkowskiMatrix.det_eq_neg_one_pow_d, det_transpose]
  group
  norm_cast
  simp


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.MinkowskiMetric
import Mathlib.LinearAlgebra.Matrix.SpecialLinearGroup
/-!
# Lorentz vector as a self-adjoint matrix

There is a linear equivalence between the vector space of space-time points
and the vector space of 2×2-complex self-adjoint matrices.

In this file we define this linear equivalence in `toSelfAdjointMatrix`.

-/
/-! TODO: Generalize rep of Lorentz vector as a self-adjoint matrix to arbitrary dimension. -/
namespace SpaceTime

open Matrix
open MatrixGroups
open Complex

/-- A 2×2-complex matrix formed from a space-time point. -/
@[simp]
def toMatrix (x : LorentzVector 3) : Matrix (Fin 2) (Fin 2) ℂ :=
  !![x.time + x.space 2, x.space 0 - x.space 1 * I; x.space 0 + x.space 1 * I, x.time - x.space 2]

/-- The matrix `x.toMatrix` for `x ∈ spaceTime` is self adjoint. -/
lemma toMatrix_isSelfAdjoint (x : LorentzVector 3) : IsSelfAdjoint (toMatrix x)

:= by
  rw [isSelfAdjoint_iff, star_eq_conjTranspose, ← Matrix.ext_iff]
  intro i j
  fin_cases i <;> fin_cases j <;>
    simp [toMatrix, conj_ofReal]
  rfl


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.NormOne
import HepLean.SpaceTime.LorentzGroup.Proper
/-!
# The Orthochronous Lorentz Group

We define the give a series of lemmas related to the orthochronous property of lorentz
matrices.

-/
/-! TODO: Prove topological properties of the Orthochronous Lorentz Group. -/

noncomputable section

open Matrix
open Complex
open ComplexConjugate

namespace LorentzGroup

variable {d : ℕ}
variable (Λ : LorentzGroup d)
open LorentzVector
open minkowskiMetric

/-- A Lorentz transformation is `orthochronous` if its `0 0` element is non-negative. -/
def IsOrthochronous : Prop := 0 ≤ timeComp Λ

lemma IsOrthochronous_iff_futurePointing :
    IsOrthochronous Λ ↔ (toNormOneLorentzVector Λ) ∈ NormOneLorentzVector.FuturePointing d := by
  simp only [IsOrthochronous, timeComp_eq_toNormOneLorentzVector]
  rw [NormOneLorentzVector.FuturePointing.mem_iff_time_nonneg]

lemma IsOrthochronous_iff_transpose :
    IsOrthochronous Λ ↔ IsOrthochronous (transpose Λ) := by rfl

lemma IsOrthochronous_iff_ge_one :
    IsOrthochronous Λ ↔ 1 ≤ timeComp Λ := by
  rw [IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.mem_iff,
    NormOneLorentzVector.time_pos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_neg_one :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ -1 := by
  rw [timeComp, IsOrthochronous_iff_futurePointing, NormOneLorentzVector.FuturePointing.not_mem_iff,
    NormOneLorentzVector.time_nonpos_iff]
  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl

lemma not_orthochronous_iff_le_zero :
    ¬ IsOrthochronous Λ ↔ timeComp Λ ≤ 0 := by
  refine Iff.intro (fun h => ?_) (fun h => ?_)
  · rw [not_orthochronous_iff_le_neg_one] at h
    linarith
  · rw [IsOrthochronous_iff_ge_one]
    linarith

/-- The continuous map taking a Lorentz transformation to its `0 0` element. -/
def timeCompCont : C(LorentzGroup d, ℝ) := ⟨fun Λ => timeComp Λ,
    Continuous.matrix_elem (continuous_iff_le_induced.mpr fun _ a => a) (Sum.inl 0) (Sum.inl 0)⟩

/-- An auxillary function used in the definition of `orthchroMapReal`. -/
def stepFunction : ℝ → ℝ := fun t =>
  if t ≤ -1 then -1 else
    if 1 ≤ t then 1 else t

lemma stepFunction_continuous : Continuous stepFunction := by
  apply Continuous.if ?_ continuous_const (Continuous.if ?_ continuous_const continuous_id)
    <;> intro a ha
  · rw [@Set.Iic_def, @frontier_Iic, @Set.mem_singleton_iff] at ha
    rw [ha]
    simp only [le_neg_self_iff, id_eq]
    have h1 : ¬ (1 : ℝ) ≤ 0 := by simp
    exact Eq.symm (if_neg h1)
  · rw [Set.Ici_def, @frontier_Ici, @Set.mem_singleton_iff] at ha
    exact id (Eq.symm ha)

/-- The continuous map from `lorentzGroup` to `ℝ` wh
taking Orthochronous elements to `1` and non-orthochronous to `-1`. -/
def orthchroMapReal : C(LorentzGroup d, ℝ) := ContinuousMap.comp
  ⟨stepFunction, stepFunction_continuous⟩ timeCompCont

lemma orthchroMapReal_on_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMapReal Λ = 1 := by
  rw [IsOrthochronous_iff_ge_one, timeComp] at h
  change stepFunction (Λ.1 _ _) = 1
  rw [stepFunction, if_pos h, if_neg]
  linarith

lemma orthchroMapReal_on_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMapReal Λ = - 1 := by
  rw [not_orthochronous_iff_le_neg_one] at h
  change stepFunction (timeComp _)= - 1
  rw [stepFunction, if_pos h]

lemma orthchroMapReal_minus_one_or_one (Λ : LorentzGroup d) :
    orthchroMapReal Λ = -1 ∨ orthchroMapReal Λ = 1 := by
  by_cases h : IsOrthochronous Λ
  · exact Or.inr $ orthchroMapReal_on_IsOrthochronous h
  · exact Or.inl $ orthchroMapReal_on_not_IsOrthochronous h

local notation "ℤ₂" => Multiplicative (ZMod 2)

/-- A continuous map from `lorentzGroup` to `ℤ₂` whose kernal are the Orthochronous elements. -/
def orthchroMap : C(LorentzGroup d, ℤ₂) :=
  ContinuousMap.comp coeForℤ₂ {
    toFun := fun Λ => ⟨orthchroMapReal Λ, orthchroMapReal_minus_one_or_one Λ⟩,
    continuous_toFun := Continuous.subtype_mk (ContinuousMap.continuous orthchroMapReal) _}

lemma orthchroMap_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMap Λ = 1 := by
  simp [orthchroMap, orthchroMapReal_on_IsOrthochronous h]

lemma orthchroMap_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMap Λ = Additive.toMul (1 : ZMod 2) := by
  simp only [orthchroMap, ContinuousMap.comp_apply, ContinuousMap.coe_mk,
    orthchroMapReal_on_not_IsOrthochronous h, coeForℤ₂_apply, Subtype.mk.injEq, Nat.reduceAdd]
  rw [if_neg]
  · rfl
  · linarith

lemma mul_othchron_of_othchron_othchron {Λ Λ' : LorentzGroup d} (h : IsOrthochronous Λ)
    (h' : IsOrthochronous Λ') : IsOrthochronous (Λ * Λ') := by
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  rw [IsOrthochronous, timeComp_mul]
  exact NormOneLorentzVector.FuturePointing.metric_reflect_mem_mem h h'

lemma mul_othchron_of_not_othchron_not_othchron {Λ Λ' : LorentzGroup d} (h : ¬ IsOrthochronous Λ)
    (h' : ¬ IsOrthochronous Λ') : IsOrthochronous (Λ * Λ') := by
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  rw [IsOrthochronous, timeComp_mul]
  exact NormOneLorentzVector.FuturePointing.metric_reflect_not_mem_not_mem h h'

lemma mul_not_othchron_of_othchron_not_othchron {Λ Λ' : LorentzGroup d} (h : IsOrthochronous Λ)
    (h' : ¬ IsOrthochronous Λ') : ¬ IsOrthochronous (Λ * Λ') := by
  rw [not_orthochronous_iff_le_zero, timeComp_mul]
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  exact NormOneLorentzVector.FuturePointing.metric_reflect_mem_not_mem h h'

lemma mul_not_othchron_of_not_othchron_othchron {Λ Λ' : LorentzGroup d} (h : ¬ IsOrthochronous Λ)
    (h' : IsOrthochronous Λ') : ¬ IsOrthochronous (Λ * Λ')

:= by
  rw [not_orthochronous_iff_le_zero, timeComp_mul]
  rw [IsOrthochronous_iff_transpose] at h
  rw [IsOrthochronous_iff_futurePointing] at h h'
  exact NormOneLorentzVector.FuturePointing.metric_reflect_not_mem_mem h h'


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.Basic
import HepLean.SpaceTime.LorentzGroup.Basic
import Mathlib.RepresentationTheory.Basic
/-!

# Lorentz group action on Lorentz vectors.

-/
noncomputable section

open BigOperators

namespace LorentzVector

variable {d : ℕ} (v : LorentzVector d)

/-- The contravariant action of the Lorentz group on a Lorentz vector. -/
def rep : Representation ℝ (LorentzGroup d) (LorentzVector d) where
  toFun g := Matrix.toLinAlgEquiv e g
  map_one' := (MulEquivClass.map_eq_one_iff (Matrix.toLinAlgEquiv e)).mpr rfl
  map_mul' x y := by
    simp only [lorentzGroupIsGroup_mul_coe, map_mul]

open Matrix in
lemma rep_apply (g : LorentzGroup d) : rep g v = g *ᵥ v := rfl

lemma rep_apply_stdBasis (g : LorentzGroup d) (μ : Fin 1 ⊕ Fin d) :
    rep g (stdBasis μ) = ∑ ν, g.1.transpose μ ν • stdBasis ν

:= by
  simp only [rep_apply, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, decomp_stdBasis']
  funext ν
  simp only [stdBasis, Matrix.transpose_apply]
  erw [Pi.basisFun_apply, Matrix.mulVec_single_one]
  rfl


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.NormOne
import HepLean.SpaceTime.LorentzGroup.Proper
/-!
# The Orthochronous Lorentz Group

We define the give a series of lemmas related to the orthochronous property of lorentz
matrices.

-/
/-! TODO: Prove topological properties of the Orthochronous Lorentz Group. -/

noncomputable section

open Matrix
open Complex
open ComplexConjugate

namespace LorentzGroup

variable {d : ℕ}
variable (Λ : LorentzGroup d)
open LorentzVector
open minkowskiMetric

/-- A Lorentz transformation is `orthochronous` if its `0 0` element is non-negative. -/
def IsOrthochronous : Prop := 0 ≤ timeComp Λ

lemma IsOrthochronous_iff_futurePointing :
    IsOrthochronous Λ ↔ (toNormOneLorentzVector Λ) ∈ NormOneLorentzVector.FuturePointing d

:= by
  simp only [IsOrthochronous, timeComp_eq_toNormOneLorentzVector]
  rw [NormOneLorentzVector.FuturePointing.mem_iff_time_nonneg]


/-
Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.SpaceTime.LorentzVector.LorentzAction
import HepLean.SpaceTime.LorentzVector.Covariant
import HepLean.Tensors.Basic
/-!

# Contractions of Lorentz vectors

We define the contraction between a covariant and contravariant Lorentz vector,
as well as properties thereof.

The structures in this file are used in `HepLean.SpaceTime.LorentzTensor.Real.Basic`
to define the contraction between indices of Lorentz tensors.

-/

noncomputable section

open TensorProduct BigOperators

namespace LorentzVector

open Matrix
variable {d : ℕ} (v : LorentzVector d)

/-- The bi-linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDownBi : LorentzVector d →ₗ[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ where
  toFun v := {
    toFun := fun w => ∑ i, v i * w i,
    map_add' := by
      intro w1 w2
      rw [← Finset.sum_add_distrib]
      refine Finset.sum_congr rfl (fun i _ => mul_add _ _ _)
    map_smul' := by
      intro r w
      simp only [RingHom.id_apply, smul_eq_mul]
      rw [Finset.mul_sum]
      refine Finset.sum_congr rfl (fun i _ => ?_)
      simp only [HSMul.hSMul, SMul.smul]
      ring}
  map_add' v1 v2 := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply]
    rw [← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl (fun i _ => add_mul _ _ _)
  map_smul' r v := by
    apply LinearMap.ext
    intro w
    simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.smul_apply]
    rw [Finset.smul_sum]
    refine Finset.sum_congr rfl (fun i _ => ?_)
    simp only [HSMul.hSMul, SMul.smul]
    exact mul_assoc r (v i) (w i)

/-- The linear map defining the contraction of a contravariant Lorentz vector
  and a covariant Lorentz vector. -/
def contrUpDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d →ₗ[ℝ] ℝ :=
  TensorProduct.lift contrUpDownBi

lemma contrUpDown_tmul_eq_dotProduct {x : LorentzVector d} {y : CovariantLorentzVector d} :
    contrUpDown (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rfl

@[simp]
lemma contrUpDown_stdBasis_left (x : LorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (x ⊗ₜ[ℝ] (CovariantLorentzVector.stdBasis i)) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · simp only [CovariantLorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    apply Or.inr hbi.symm

@[simp]
lemma contrUpDown_stdBasis_right (x : CovariantLorentzVector d) (i : Fin 1 ⊕ Fin d) :
    contrUpDown (e i ⊗ₜ[ℝ] x) = x i := by
  simp only [contrUpDown, contrUpDownBi, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk]
  rw [Finset.sum_eq_single_of_mem i]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, one_mul]
  · exact Finset.mem_univ i
  · intro b _ hbi
    simp only [CovariantLorentzVector.stdBasis, mul_eq_zero]
    erw [Pi.basisFun_apply]
    left
    simp only [LinearMap.stdBasis_apply', ite_eq_right_iff, one_ne_zero, imp_false]
    exact hbi.symm

/-- The linear map defining the contraction of a covariant Lorentz vector
  and a contravariant Lorentz vector. -/
def contrDownUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d →ₗ[ℝ] ℝ :=
  contrUpDown ∘ₗ (TensorProduct.comm ℝ _ _).toLinearMap

lemma contrDownUp_tmul_eq_dotProduct {x : CovariantLorentzVector d} {y : LorentzVector d} :
    contrDownUp (x ⊗ₜ[ℝ] y) = x ⬝ᵥ y := by
  rw [dotProduct_comm x y]
  rfl

/-!

## The unit of the contraction

-/

/-- The unit of the contraction of contravariant Lorentz vector and a
  covariant Lorentz vector. -/
def unitUp : CovariantLorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ i, CovariantLorentzVector.stdBasis i ⊗ₜ[ℝ] LorentzVector.stdBasis i

lemma unitUp_rid (x : LorentzVector d) :
    TensorStructure.contrLeftAux contrUpDown (x ⊗ₜ[ℝ] unitUp) = x := by
  simp only [unitUp, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, LinearEquiv.refl_toLinearMap, Fintype.sum_sum_type,
    Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, map_add,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul, map_sum, decomp_stdBasis']

/-- The unit of the contraction of covariant Lorentz vector and a
  contravariant Lorentz vector. -/
def unitDown : LorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ i, LorentzVector.stdBasis i ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis i

lemma unitDown_rid (x : CovariantLorentzVector d) :
    TensorStructure.contrLeftAux contrDownUp (x ⊗ₜ[ℝ] unitDown) = x := by
  simp only [unitDown, LinearEquiv.refl_toLinearMap]
  rw [tmul_sum]
  simp only [TensorStructure.contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap,
    Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply,
    assoc_symm_tmul, map_tmul, comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq,
    lid_tmul, map_sum, CovariantLorentzVector.decomp_stdBasis']

/-!

# Contractions and the Lorentz actions

-/
open Matrix

@[simp]
lemma contrUpDown_invariant_lorentzAction : @contrUpDown d ((LorentzVector.rep g) x ⊗ₜ[ℝ]
    (CovariantLorentzVector.rep g) y) = contrUpDown (x ⊗ₜ[ℝ] y) := by
  rw [contrUpDown_tmul_eq_dotProduct, contrUpDown_tmul_eq_dotProduct]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

@[simp]
lemma contrDownUp_invariant_lorentzAction : @contrDownUp d ((CovariantLorentzVector.rep g) x ⊗ₜ[ℝ]
    (LorentzVector.rep g) y) = contrDownUp (x ⊗ₜ[ℝ] y) := by
  rw [contrDownUp_tmul_eq_dotProduct, contrDownUp_tmul_eq_dotProduct]
  rw [dotProduct_comm, dotProduct_comm x y]
  simp only [rep_apply, CovariantLorentzVector.rep_apply]
  rw [Matrix.dotProduct_mulVec, vecMul_transpose, mulVec_mulVec]
  simp only [LorentzGroup.subtype_inv_mul, one_mulVec]

end LorentzVector

namespace minkowskiMatrix
open LorentzVector
open TensorStructure
open scoped minkowskiMatrix
variable {d : ℕ}

/-- The metric tensor as an element of `LorentzVector d ⊗[ℝ] LorentzVector d`. -/
def asTenProd : LorentzVector d ⊗[ℝ] LorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis ν)

lemma asTenProd_diag :
    @asTenProd d = ∑ μ, η μ μ • (LorentzVector.stdBasis μ ⊗ₜ[ℝ] LorentzVector.stdBasis μ) := by
  simp only [asTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    exact TensorProduct.zero_smul (e μ ⊗ₜ[ℝ] e ν)
  · intro a
    rename_i j
    exact False.elim (a j)

/-- The metric tensor as an element of `CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d`. -/
def asCoTenProd : CovariantLorentzVector d ⊗[ℝ] CovariantLorentzVector d :=
  ∑ μ, ∑ ν, η μ ν • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis ν)

lemma asCoTenProd_diag :
    @asCoTenProd d = ∑ μ, η μ μ • (CovariantLorentzVector.stdBasis μ ⊗ₜ[ℝ]
      CovariantLorentzVector.stdBasis μ) := by
  simp only [asCoTenProd]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [Finset.sum_eq_single μ]
  · intro ν _ hμν
    rw [minkowskiMatrix.off_diag_zero hμν.symm]
    simp only [zero_smul]
  · intro a
    simp_all only

@[simp]
lemma contrLeft_asTenProd (x : CovariantLorentzVector d) :
    contrLeftAux contrDownUp (x ⊗ₜ[ℝ] asTenProd) =
    ∑ μ, ((η μ μ * x μ) • LorentzVector.stdBasis μ) := by
  simp only [asTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, contrDownUp, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    comm_tmul, contrUpDown_stdBasis_right, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (e μ)

@[simp]
lemma contrLeft_asCoTenProd (x : LorentzVector d) :
    contrLeftAux contrUpDown (x ⊗ₜ[ℝ] asCoTenProd) =
    ∑ μ, ((η μ μ * x μ) • CovariantLorentzVector.stdBasis μ) := by
  simp only [asCoTenProd_diag]
  rw [tmul_sum]
  rw [map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  simp only [contrLeftAux, LinearEquiv.refl_toLinearMap, tmul_smul, map_smul,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, assoc_symm_tmul, map_tmul,
    contrUpDown_stdBasis_left, LinearMap.id_coe, id_eq, lid_tmul]
  exact smul_smul (η μ μ) (x μ) (CovariantLorentzVector.stdBasis μ)

@[simp]
lemma asTenProd_contr_asCoTenProd :
    (contrMidAux (contrUpDown) (asTenProd ⊗ₜ[ℝ] asCoTenProd))
    = TensorProduct.comm ℝ _ _ (@unitUp d) := by
  simp only [contrMidAux, LinearEquiv.refl_toLinearMap, asTenProd_diag, LinearMap.coe_comp,
    LinearEquiv.coe_coe, Function.comp_apply]
  rw [sum_tmul, map_sum, map_sum, unitUp]
  simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, comm_tmul, map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [← tmul_smul, TensorProduct.assoc_tmul]
  simp only [map_tmul, LinearMap.id_coe, id_eq, contrLeft_asCoTenProd]
  rw [tmul_sum, Finset.sum_eq_single_of_mem μ, tmul_smul]
  · change (η μ μ * (η μ μ * e μ μ)) • e μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis μ = _
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one, η_apply_mul_η_apply_diag, one_smul]
  · exact Finset.mem_univ μ
  · intro ν _ hμν
    rw [tmul_smul]
    change (η ν ν * (η μ μ * e μ ν)) • (e μ ⊗ₜ[ℝ] CovariantLorentzVector.stdBasis ν) = _
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', mul_ite, mul_one, mul_zero, ite_smul, zero_smul,
      ite_eq_right_iff, smul_eq_zero, mul_eq_zero]
    exact fun a => False.elim (hμν a.symm)

@[simp]
lemma asCoTenProd_contr_asTenProd :
    (contrMidAux (contrDownUp) (asCoTenProd ⊗ₜ[ℝ] asTenProd))
    = TensorProduct.comm ℝ _ _ (@unitDown d)

:= by
  simp only [contrMidAux, LinearEquiv.refl_toLinearMap, asCoTenProd_diag,
    LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply]
  rw [sum_tmul, map_sum, map_sum, unitDown]
  simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue,
    Finset.sum_singleton, map_add, comm_tmul, map_sum]
  refine Finset.sum_congr rfl (fun μ _ => ?_)
  rw [smul_tmul, TensorProduct.assoc_tmul]
  simp only [tmul_smul, map_smul, map_tmul, LinearMap.id_coe, id_eq,
    contrLeft_asTenProd]
  rw [tmul_sum, Finset.sum_eq_single_of_mem μ, tmul_smul, smul_smul, LorentzVector.stdBasis]
  · erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', ↓reduceIte, mul_one, η_apply_mul_η_apply_diag, one_smul]
  · exact Finset.mem_univ μ
  · intro ν _ hμν
    rw [tmul_smul]
    rw [LorentzVector.stdBasis]
    erw [Pi.basisFun_apply]
    simp only [LinearMap.stdBasis_apply', mul_ite, mul_one, mul_zero, ite_smul, zero_smul,
      ite_eq_right_iff, smul_eq_zero]
    exact fun a => False.elim (hμν a.symm)