refactor: Major refactor of lorentz group

2024-07-01 16:56:15 -04:00 · 2024-07-01 16:56:15 -04:00 · 675b9a989a
commit 675b9a989a
parent 0116994a58
11 changed files with 866 additions and 208 deletions
--- a/HepLean/SpaceTime/LorentzGroup/Basic.lean
+++ b/HepLean/SpaceTime/LorentzGroup/Basic.lean
@ -3,8 +3,9 @@ Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
 Released under Apache 2.0 license.
 Authors: Joseph Tooby-Smith
 -/
-import HepLean.SpaceTime.Metric
+import HepLean.SpaceTime.MinkowskiMetric
 import HepLean.SpaceTime.AsSelfAdjointMatrix
+import HepLean.SpaceTime.LorentzVector.NormOne
 /-!
 # The Lorentz Group

@ -26,7 +27,6 @@ identity.

 noncomputable section

-namespace SpaceTime

 open Manifold
 open Matrix
@ -34,146 +34,139 @@ open Complex
 open ComplexConjugate

 /-!
-## Matrices which preserve `ηLin`
+## Matrices which preserves the Minkowski metric

 We start studying the properties of matrices which preserve `ηLin`.
 These matrices form the Lorentz group, which we will define in the next section at `lorentzGroup`.

 -/
+variable  {d : ℕ}

-/-- We say a matrix `Λ` preserves `ηLin` if for all `x` and `y`,
-  `ηLin (Λ *ᵥ x) (Λ *ᵥ y) = ηLin x y`.  -/
-def PreservesηLin (Λ : Matrix (Fin 4) (Fin 4) ℝ) : Prop :=
-  ∀ (x y : SpaceTime), ηLin (Λ *ᵥ x) (Λ *ᵥ y) = ηLin x y
+open minkowskiMetric in
+/-- The Lorentz group is the subset of matrices which preserve the minkowski metric. -/
+def LorentzGroup (d : ℕ) : Set (Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) :=
+    {Λ : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ |
+     ∀ (x y : LorentzVector d), ⟪Λ *ᵥ x, Λ *ᵥ y⟫ₘ = ⟪x, y⟫ₘ}

-namespace PreservesηLin

-variable  (Λ : Matrix (Fin 4) (Fin 4) ℝ)
+namespace LorentzGroup
+/-- Notation for the Lorentz group. -/
+scoped[LorentzGroup] notation (name := lorentzGroup_notation) "𝓛" => LorentzGroup

-lemma iff_norm : PreservesηLin Λ ↔
-    ∀ (x : SpaceTime), ηLin (Λ *ᵥ x) (Λ *ᵥ x) = ηLin x x := by
+open minkowskiMetric
+
+variable  {Λ Λ' : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ}
+
+/-!
+
+# Membership conditions
+
+-/
+
+lemma mem_iff_norm :  Λ ∈ LorentzGroup d ↔
+    ∀ (x : LorentzVector d), ⟪Λ *ᵥ x, Λ *ᵥ x⟫ₘ = ⟪x, x⟫ₘ := by
  refine Iff.intro (fun h x => h x x) (fun h x y => ?_)
  have hp := h (x + y)
  have hn := h (x - y)
  rw [mulVec_add] at hp
  rw [mulVec_sub] at hn
  simp only [map_add, LinearMap.add_apply, map_sub, LinearMap.sub_apply] at hp hn
-  rw [ηLin_symm (Λ *ᵥ y) (Λ *ᵥ x), ηLin_symm y x] at hp hn
+  rw [symm (Λ *ᵥ y) (Λ *ᵥ x), symm y x] at hp hn
  linear_combination hp / 4 + -1 * hn / 4

-lemma iff_det_selfAdjoint : PreservesηLin Λ ↔
-    ∀ (x : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)),
-    det ((toSelfAdjointMatrix ∘ toLin stdBasis stdBasis Λ ∘ toSelfAdjointMatrix.symm) x).1
-    = det x.1 := by
-  rw [iff_norm]
-  apply Iff.intro
-  intro h x
-  have h1 := congrArg ofReal $ h (toSelfAdjointMatrix.symm x)
-  simpa [← det_eq_ηLin] using h1
-  intro h x
-  have h1 := h (toSelfAdjointMatrix x)
-  simpa [det_eq_ηLin] using h1
-
-lemma iff_on_right : PreservesηLin Λ ↔
-    ∀ (x y : SpaceTime), ηLin x ((η * Λᵀ * η * Λ) *ᵥ y) = ηLin x y := by
+lemma mem_iff_on_right : Λ ∈ LorentzGroup d ↔
+    ∀ (x y : LorentzVector d), ⟪x, (dual Λ * Λ) *ᵥ y⟫ₘ = ⟪x, y⟫ₘ := by
  apply Iff.intro
  intro h x y
  have h1 := h x y
-  rw [ηLin_mulVec_left, mulVec_mulVec] at h1
+  rw [← dual_mulVec_right, mulVec_mulVec] at h1
  exact h1
  intro h x y
-  rw [ηLin_mulVec_left, mulVec_mulVec]
+  rw [← dual_mulVec_right, mulVec_mulVec]
  exact h x y

-lemma iff_matrix : PreservesηLin Λ ↔ η * Λᵀ * η * Λ = 1  := by
-  rw [iff_on_right, ηLin_matrix_eq_identity_iff (η * Λᵀ * η * Λ)]
-  apply Iff.intro
-  · simp_all  [ηLin, implies_true, iff_true, one_mulVec]
-  · exact fun a x y => Eq.symm (Real.ext_cauchy (congrArg Real.cauchy (a x y)))
+lemma mem_iff_dual_mul_self : Λ ∈ LorentzGroup d ↔ dual Λ * Λ = 1  := by
+  rw [mem_iff_on_right, matrix_eq_id_iff]
+  exact forall_comm

-lemma iff_matrix' : PreservesηLin Λ ↔ Λ * (η * Λᵀ * η) = 1  := by
-  rw [iff_matrix]
+lemma mem_iff_self_mul_dual :  Λ ∈ LorentzGroup d ↔ Λ * dual Λ = 1  := by
+  rw [mem_iff_dual_mul_self]
  exact mul_eq_one_comm


-lemma iff_transpose : PreservesηLin Λ ↔ PreservesηLin Λᵀ := by
+lemma mem_iff_transpose : Λ ∈ LorentzGroup d ↔ Λᵀ ∈ LorentzGroup d := by
  apply Iff.intro
-  intro h
-  have h1 := congrArg transpose ((iff_matrix Λ).mp h)
-  rw [transpose_mul, transpose_mul, transpose_mul, η_transpose,
-    ← mul_assoc, transpose_one] at h1
-  rw [iff_matrix' Λ.transpose, ← h1]
-  noncomm_ring
-  intro h
-  have h1 := congrArg transpose ((iff_matrix Λ.transpose).mp h)
-  rw [transpose_mul, transpose_mul, transpose_mul, η_transpose,
-    ← mul_assoc, transpose_one, transpose_transpose] at h1
-  rw [iff_matrix', ← h1]
+  · intro h
+    have h1 := congrArg transpose ((mem_iff_dual_mul_self).mp h)
+    rw [dual, transpose_mul, transpose_mul, transpose_mul, minkowskiMatrix.eq_transpose,
+      ← mul_assoc, transpose_one] at h1
+    rw [mem_iff_self_mul_dual, ← h1, dual]
+    noncomm_ring
+  · intro h
+    have h1 := congrArg transpose ((mem_iff_dual_mul_self).mp h)
+    rw [dual, transpose_mul, transpose_mul, transpose_mul, minkowskiMatrix.eq_transpose,
+      ← mul_assoc, transpose_one, transpose_transpose] at h1
+    rw [mem_iff_self_mul_dual, ← h1, dual]
+    noncomm_ring
+
+lemma mem_mul (hΛ : Λ ∈ LorentzGroup d) (hΛ' : Λ' ∈ LorentzGroup d) : Λ * Λ' ∈ LorentzGroup d := by
+  rw [mem_iff_dual_mul_self, dual_mul]
+  trans dual Λ' * (dual Λ * Λ) * Λ'
  noncomm_ring
+  rw [(mem_iff_dual_mul_self).mp hΛ]
+  simp [(mem_iff_dual_mul_self).mp hΛ']

-/-- The lift of a matrix which preserves `ηLin` to an invertible matrix. -/
-def liftGL {Λ : Matrix (Fin 4) (Fin 4) ℝ} (h : PreservesηLin Λ) : GL (Fin 4) ℝ :=
-  ⟨Λ, η * Λᵀ * η , (iff_matrix' Λ).mp h , (iff_matrix Λ).mp h⟩
-
-lemma mul {Λ Λ' : Matrix (Fin 4) (Fin 4) ℝ} (h : PreservesηLin Λ) (h' : PreservesηLin Λ') :
-    PreservesηLin (Λ * Λ') := by
-  intro x y
-  rw [← mulVec_mulVec, ← mulVec_mulVec, h, h']
-
-lemma one : PreservesηLin 1 := by
-  intro x y
+lemma one_mem : 1 ∈ LorentzGroup d := by
+  rw [mem_iff_dual_mul_self]
  simp

-lemma η : PreservesηLin η := by
-  simp [iff_matrix, η_transpose, η_sq]
+lemma dual_mem (h : Λ ∈ LorentzGroup d) : dual Λ ∈ LorentzGroup d := by
+  rw [mem_iff_dual_mul_self, dual_dual]
+  exact mem_iff_self_mul_dual.mp h

-end PreservesηLin
+end LorentzGroup

 /-!
-## The Lorentz group

-We define the Lorentz group as the set of matrices which preserve `ηLin`.
-We show that the Lorentz group is indeed a group.
+# The Lorentz group as a group

 -/

-/-- The Lorentz group is the subset of matrices which preserve ηLin. -/
-def LorentzGroup : Type := {Λ : Matrix (Fin 4) (Fin 4) ℝ // PreservesηLin Λ}
-
@[simps mul_coe one_coe inv div]
-instance lorentzGroupIsGroup : Group LorentzGroup where
-  mul A B := ⟨A.1 * B.1, PreservesηLin.mul A.2 B.2⟩
+instance lorentzGroupIsGroup : Group (LorentzGroup d) where
+  mul A B := ⟨A.1 * B.1, LorentzGroup.mem_mul A.2 B.2⟩
  mul_assoc A B C := by
    apply Subtype.eq
    exact Matrix.mul_assoc A.1 B.1 C.1
-  one := ⟨1, PreservesηLin.one⟩
+  one := ⟨1, LorentzGroup.one_mem⟩
  one_mul A := by
    apply Subtype.eq
    exact Matrix.one_mul A.1
  mul_one A := by
    apply Subtype.eq
    exact Matrix.mul_one A.1
-  inv A := ⟨η * A.1ᵀ * η , PreservesηLin.mul (PreservesηLin.mul PreservesηLin.η
-    ((PreservesηLin.iff_transpose A.1).mp A.2)) PreservesηLin.η⟩
+  inv A := ⟨minkowskiMetric.dual A.1, LorentzGroup.dual_mem A.2⟩
  mul_left_inv A := by
    apply Subtype.eq
-    exact (PreservesηLin.iff_matrix A.1).mp A.2
+    exact LorentzGroup.mem_iff_dual_mul_self.mp A.2

-/-- Notation for the Lorentz group. -/
-scoped[SpaceTime] notation (name := lorentzGroup_notation) "𝓛" => LorentzGroup
-
-
-/-- `lorentzGroup` has the subtype topology. -/
-instance : TopologicalSpace LorentzGroup := instTopologicalSpaceSubtype
+/-- `LorentzGroup` has the subtype topology. -/
+instance : TopologicalSpace (LorentzGroup d) := instTopologicalSpaceSubtype

 namespace LorentzGroup

-lemma coe_inv (A : LorentzGroup) : (A⁻¹).1 = A.1⁻¹:= by
+open minkowskiMetric
+
+variable  {Λ Λ' : LorentzGroup d}
+
+@[simp]
+lemma coe_inv  : (Λ⁻¹).1 = Λ.1⁻¹:= by
  refine (inv_eq_left_inv ?h).symm
-  exact (PreservesηLin.iff_matrix A.1).mp A.2
+  exact mem_iff_dual_mul_self.mp Λ.2

 /-- The transpose of an matrix in the Lorentz group is an element of the Lorentz group. -/
-def transpose (Λ : LorentzGroup) : LorentzGroup := ⟨Λ.1ᵀ, (PreservesηLin.iff_transpose Λ.1).mp Λ.2⟩
+def transpose (Λ : LorentzGroup d) : LorentzGroup d :=
+  ⟨Λ.1ᵀ, mem_iff_transpose.mp Λ.2⟩

 /-!

@ -186,9 +179,9 @@ embedding.
 -/

 /-- The homomorphism of the Lorentz group into `GL (Fin 4) ℝ`. -/
-def toGL : LorentzGroup →* GL (Fin 4) ℝ where
-  toFun A := ⟨A.1, (A⁻¹).1, mul_eq_one_comm.mpr $ (PreservesηLin.iff_matrix A.1).mp A.2,
-    (PreservesηLin.iff_matrix A.1).mp A.2⟩
+def toGL : LorentzGroup d →* GL (Fin 1 ⊕ Fin d) ℝ where
+  toFun A := ⟨A.1, (A⁻¹).1, mul_eq_one_comm.mpr $ mem_iff_dual_mul_self.mp A.2,
+    mem_iff_dual_mul_self.mp A.2⟩
  map_one' := by
    simp
    rfl
@ -197,7 +190,7 @@ def toGL : LorentzGroup →* GL (Fin 4) ℝ where
    ext
    rfl

-lemma toGL_injective : Function.Injective toGL := by
+lemma toGL_injective : Function.Injective (@toGL d) := by
  intro A B h
  apply Subtype.eq
  rw [@Units.ext_iff] at h
@ -206,20 +199,21 @@ lemma toGL_injective : Function.Injective toGL := by
 /-- The homomorphism from the Lorentz Group into the monoid of matrices times the opposite of
  the monoid of matrices. -/
@[simps!]
-def toProd : LorentzGroup →* (Matrix (Fin 4) (Fin 4) ℝ) × (Matrix (Fin 4) (Fin 4) ℝ)ᵐᵒᵖ :=
+def toProd : LorentzGroup d →* (Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) ×
+    (Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ)ᵐᵒᵖ :=
  MonoidHom.comp (Units.embedProduct _) toGL

-lemma toProd_eq_transpose_η  : toProd A = (A.1, ⟨η * A.1ᵀ * η⟩) := rfl
+lemma toProd_eq_transpose_η  : toProd Λ = (Λ.1, MulOpposite.op $ minkowskiMetric.dual Λ.1) := rfl

-lemma toProd_injective : Function.Injective toProd := by
+lemma toProd_injective : Function.Injective (@toProd d) := by
  intro A B h
  rw [toProd_eq_transpose_η, toProd_eq_transpose_η] at h
  rw [@Prod.mk.inj_iff] at h
  apply Subtype.eq
  exact h.1

-lemma toProd_continuous : Continuous toProd := by
-  change Continuous (fun A => (A.1, ⟨η * A.1ᵀ * η⟩))
+lemma toProd_continuous : Continuous (@toProd d) := by
+  change Continuous (fun A => (A.1, ⟨dual A.1⟩))
  refine continuous_prod_mk.mpr (And.intro ?_ ?_)
  exact continuous_iff_le_induced.mpr fun U a => a
  refine Continuous.comp' ?_ ?_
@ -230,7 +224,7 @@ lemma toProd_continuous : Continuous toProd := by

 /-- The embedding from the Lorentz Group into the monoid of matrices times the opposite of
  the monoid of matrices. -/
-lemma toProd_embedding : Embedding toProd where
+lemma toProd_embedding : Embedding (@toProd d) where
  inj := toProd_injective
  induced := by
    refine (inducing_iff ⇑toProd).mp ?_
@ -238,7 +232,7 @@ lemma toProd_embedding : Embedding toProd where
    exact (inducing_iff (Prod.fst ∘ ⇑toProd)).mpr rfl

 /-- The embedding from the Lorentz Group into `GL (Fin 4) ℝ`. -/
-lemma toGL_embedding : Embedding toGL.toFun where
+lemma toGL_embedding : Embedding (@toGL d).toFun where
  inj := toGL_injective
  induced := by
    refine ((fun {X} {t t'} => TopologicalSpace.ext_iff.mpr) ?_).symm
@ -248,11 +242,48 @@ lemma toGL_embedding : Embedding toGL.toFun where
    exact exists_exists_and_eq_and


-instance : TopologicalGroup LorentzGroup := Inducing.topologicalGroup toGL toGL_embedding.toInducing
+instance : TopologicalGroup (LorentzGroup d) :=
+Inducing.topologicalGroup toGL toGL_embedding.toInducing
+
+section
+open LorentzVector
+/-!
+
+# To a norm one Lorentz vector
+
+-/
+
+/-- The first column of a lorentz matrix as a `NormOneLorentzVector`. -/
+@[simps!]
+def toNormOneLorentzVector (Λ : LorentzGroup d) : NormOneLorentzVector d :=
+  ⟨Λ.1 *ᵥ timeVec, by rw [NormOneLorentzVector.mem_iff, Λ.2, minkowskiMetric.on_timeVec]⟩
+
+/-!
+
+# The time like element
+
+-/
+
+/-- The time like element of a Lorentz matrix. -/
+@[simp]
+def timeComp (Λ : LorentzGroup d) : ℝ := Λ.1 (Sum.inl 0) (Sum.inl 0)
+
+lemma timeComp_eq_toNormOneLorentzVector : timeComp Λ = (toNormOneLorentzVector Λ).1.time := by
+  simp only [time, toNormOneLorentzVector, timeVec, Fin.isValue, timeComp]
+  erw [Pi.basisFun_apply, mulVec_stdBasis]
+
+lemma timeComp_mul (Λ Λ' : LorentzGroup d) : timeComp (Λ * Λ') =
+    ⟪toNormOneLorentzVector (transpose Λ), (toNormOneLorentzVector Λ').1.spaceReflection⟫ₘ := by
+  simp only [timeComp, Fin.isValue, lorentzGroupIsGroup_mul_coe, mul_apply, Fintype.sum_sum_type,
+    Finset.univ_unique, Fin.default_eq_zero, Finset.sum_singleton, toNormOneLorentzVector,
+    transpose, timeVec, right_spaceReflection, time, space, PiLp.inner_apply, Function.comp_apply,
+    RCLike.inner_apply, conj_trivial]
+  erw [Pi.basisFun_apply, mulVec_stdBasis]
+  simp



+
+
+end
 end LorentzGroup
-
-
-end SpaceTime
--- a/HepLean/SpaceTime/LorentzGroup/Boosts.lean
+++ b/HepLean/SpaceTime/LorentzGroup/Boosts.lean
@ -5,7 +5,7 @@ Authors: Joseph Tooby-Smith
 -/
 import HepLean.SpaceTime.LorentzGroup.Proper
 import Mathlib.Topology.Constructions
-import HepLean.SpaceTime.FourVelocity
+import HepLean.SpaceTime.LorentzVector.NormOne
 /-!
 # Boosts

@ -28,15 +28,17 @@ A boost is the special case of a generalised boost when `u = stdBasis 0`.

 -/
 noncomputable section
-namespace SpaceTime

 namespace LorentzGroup

-open FourVelocity
+open NormOneLorentzVector
+open minkowskiMetric
+
+variable {d : ℕ}

 /-- An auxillary linear map used in the definition of a generalised boost. -/
-def genBoostAux₁ (u v : FourVelocity) : SpaceTime →ₗ[ℝ] SpaceTime where
-  toFun x := (2 * ηLin x u) • v.1.1
+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]
@ -46,17 +48,21 @@ def genBoostAux₁ (u v : FourVelocity) : SpaceTime →ₗ[ℝ] SpaceTime where
    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 : FourVelocity) : SpaceTime →ₗ[ℝ] SpaceTime where
-  toFun x := - (ηLin x (u + v) / (1 + ηLin u v)) • (u + v)
+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 [ηLin.map_add, div_eq_mul_one_div]
-    rw [show (ηLin x + ηLin y) (↑u + ↑v) = ηLin x (u+v) + ηLin y (u+v) from rfl]
-    rw [add_mul, neg_add, add_smul, ← div_eq_mul_one_div, ← div_eq_mul_one_div]
+    rw [← add_smul]
+    apply congrFun
+    apply congrArg
+    field_simp
+    apply congrFun
+    apply congrArg
+    ring
  map_smul' c x := by
    simp only
-    rw [ηLin.map_smul]
-    rw [show (c • ηLin x) (↑u + ↑v) = c * ηLin x (u+v) from rfl]
+    rw [map_smul]
+    rw [show (c • minkowskiMetric x) (↑u + ↑v) = c * minkowskiMetric x (u+v) from rfl]
    rw [mul_div_assoc, neg_mul_eq_mul_neg, smul_smul]
    rfl

@ -174,5 +180,4 @@ end genBoost
 end LorentzGroup


-end SpaceTime
 end
--- a/HepLean/SpaceTime/LorentzGroup/Orthochronous.lean
+++ b/HepLean/SpaceTime/LorentzGroup/Orthochronous.lean
@ -3,7 +3,7 @@ Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved.
 Released under Apache 2.0 license.
 Authors: Joseph Tooby-Smith
 -/
-import HepLean.SpaceTime.FourVelocity
+import HepLean.SpaceTime.LorentzVector.NormOne
 import HepLean.SpaceTime.LorentzGroup.Proper
 /-!
 # The Orthochronous Lorentz Group
@ -20,7 +20,6 @@ matrices.

 noncomputable section

-namespace SpaceTime

 open Manifold
 open Matrix
@ -28,37 +27,50 @@ open Complex
 open ComplexConjugate

 namespace LorentzGroup
-open PreFourVelocity

-/-- The first column of a lorentz matrix as a `PreFourVelocity`. -/
-@[simp]
-def fstCol (Λ : LorentzGroup) : PreFourVelocity := ⟨Λ.1 *ᵥ stdBasis 0, by
-  rw [mem_PreFourVelocity_iff, ηLin_expand]
-  simp only [Fin.isValue, stdBasis_mulVec]
-  have h00 := congrFun (congrFun ((PreservesηLin.iff_matrix Λ.1).mp  Λ.2) 0) 0
-  simp only [Fin.isValue, mul_apply, transpose_apply, Fin.sum_univ_four, ne_eq, zero_ne_one,
-    not_false_eq_true, η_off_diagonal, zero_mul, add_zero, Fin.reduceEq, one_ne_zero, mul_zero,
-    zero_add, one_apply_eq] at h00
-  simp only [η_explicit, Fin.isValue, of_apply, cons_val', cons_val_zero, empty_val',
-    cons_val_fin_one, vecCons_const, one_mul, mul_one, cons_val_one, head_cons, mul_neg, neg_mul,
-    cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, tail_cons, cons_val_three,
-     head_fin_const] at h00
-  exact h00⟩
+variable {d : ℕ}
+variable (Λ : LorentzGroup d)
+open LorentzVector
+open minkowskiMetric

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

-lemma IsOrthochronous_iff_transpose (Λ : LorentzGroup) :
+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_fstCol_IsFourVelocity (Λ : LorentzGroup) :
-    IsOrthochronous Λ ↔ IsFourVelocity (fstCol Λ) := by
-  simp [IsOrthochronous, IsFourVelocity]
-  rw [stdBasis_mulVec]
+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, mulVec_stdBasis]
+  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, mulVec_stdBasis]
+
+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 mapZeroZeroComp : C(LorentzGroup, ℝ) := ⟨fun Λ => Λ.1 0 0,
-   Continuous.matrix_elem (continuous_iff_le_induced.mpr fun _ a => a) 0 0⟩
+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 =>
@ -78,29 +90,23 @@ lemma stepFunction_continuous : Continuous stepFunction := by

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

-lemma orthchroMapReal_on_IsOrthochronous {Λ : LorentzGroup} (h : IsOrthochronous Λ) :
+lemma orthchroMapReal_on_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMapReal Λ = 1 := by
-  rw [IsOrthochronous_iff_fstCol_IsFourVelocity] at h
-  simp only [IsFourVelocity] at h
-  rw [zero_nonneg_iff] at h
-  simp [stdBasis_mulVec] at h
-  have h1 : ¬  Λ.1 0 0 ≤  (-1 : ℝ) := by linarith
-  change stepFunction (Λ.1 0 0) = 1
-  rw [stepFunction, if_neg h1, if_pos h]
+  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} (h : ¬ IsOrthochronous Λ) :
+lemma orthchroMapReal_on_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMapReal Λ = - 1 := by
-  rw [IsOrthochronous_iff_fstCol_IsFourVelocity] at h
-  rw [not_IsFourVelocity_iff, zero_nonpos_iff] at h
-  simp only [fstCol, Fin.isValue, stdBasis_mulVec] at h
-  change stepFunction (Λ.1 0 0) = - 1
+  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) :
+lemma orthchroMapReal_minus_one_or_one (Λ : LorentzGroup d) :
    orthchroMapReal Λ = -1 ∨ orthchroMapReal Λ = 1 := by
  by_cases h : IsOrthochronous Λ
  apply Or.inr $ orthchroMapReal_on_IsOrthochronous h
@ -109,65 +115,50 @@ lemma orthchroMapReal_minus_one_or_one (Λ : LorentzGroup) :
 local notation  "ℤ₂" => Multiplicative (ZMod 2)

 /-- A continuous map from `lorentzGroup` to `ℤ₂` whose kernal are the Orthochronous elements. -/
-def orthchroMap : C(LorentzGroup, ℤ₂) :=
+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} (h : IsOrthochronous Λ) :
+lemma orthchroMap_IsOrthochronous {Λ : LorentzGroup d} (h : IsOrthochronous Λ) :
    orthchroMap Λ = 1 := by
  simp [orthchroMap, orthchroMapReal_on_IsOrthochronous h]

-lemma orthchroMap_not_IsOrthochronous {Λ : LorentzGroup} (h : ¬ IsOrthochronous Λ) :
+lemma orthchroMap_not_IsOrthochronous {Λ : LorentzGroup d} (h : ¬ IsOrthochronous Λ) :
    orthchroMap Λ =  Additive.toMul (1 : ZMod 2) := by
  simp [orthchroMap, orthchroMapReal_on_not_IsOrthochronous h]
  rfl

-lemma zero_zero_mul (Λ Λ' : LorentzGroup) :
-    (Λ * Λ').1 0 0 =  (fstCol (transpose Λ)).1 0 * (fstCol Λ').1 0 +
-    ⟪(fstCol (transpose Λ)).1.space, (fstCol Λ').1.space⟫_ℝ := by
-  simp only [Fin.isValue, lorentzGroupIsGroup_mul_coe, mul_apply, Fin.sum_univ_four, fstCol,
-    transpose, stdBasis_mulVec, transpose_apply, space, PiLp.inner_apply, Nat.succ_eq_add_one,
-    Nat.reduceAdd, RCLike.inner_apply, conj_trivial, Fin.sum_univ_three, cons_val_zero,
-    cons_val_one, head_cons, cons_val_two, tail_cons]
-  ring
-
-lemma mul_othchron_of_othchron_othchron {Λ Λ' : LorentzGroup} (h : IsOrthochronous Λ)
+lemma mul_othchron_of_othchron_othchron {Λ Λ' : LorentzGroup d} (h : IsOrthochronous Λ)
    (h' : IsOrthochronous Λ') : IsOrthochronous (Λ * Λ') := by
  rw [IsOrthochronous_iff_transpose] at h
-  rw [IsOrthochronous_iff_fstCol_IsFourVelocity] at h h'
-  rw [IsOrthochronous, zero_zero_mul]
-  exact euclid_norm_IsFourVelocity_IsFourVelocity h 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} (h : ¬  IsOrthochronous Λ)
+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_fstCol_IsFourVelocity] at h h'
-  rw [IsOrthochronous, zero_zero_mul]
-  exact euclid_norm_not_IsFourVelocity_not_IsFourVelocity h 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} (h :  IsOrthochronous Λ)
+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_fstCol_IsFourVelocity] at h h'
-  rw [IsOrthochronous_iff_fstCol_IsFourVelocity, not_IsFourVelocity_iff]
-  simp [stdBasis_mulVec]
-  change (Λ * Λ').1 0 0  ≤ _
-  rw [zero_zero_mul]
-  exact euclid_norm_IsFourVelocity_not_IsFourVelocity h 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} (h : ¬ IsOrthochronous Λ)
+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_fstCol_IsFourVelocity] at h h'
-  rw [IsOrthochronous_iff_fstCol_IsFourVelocity, not_IsFourVelocity_iff]
-  simp [stdBasis_mulVec]
-  change (Λ * Λ').1 0 0  ≤ _
-  rw [zero_zero_mul]
-  exact euclid_norm_not_IsFourVelocity_IsFourVelocity h h'
+  rw [IsOrthochronous_iff_futurePointing] at h h'
+  exact NormOneLorentzVector.FuturePointing.metric_reflect_not_mem_mem h h'

 /-- The homomorphism from `lorentzGroup` to `ℤ₂` whose kernel are the Orthochronous elements. -/
-def orthchroRep : LorentzGroup →* ℤ₂ where
+def orthchroRep : LorentzGroup d →* ℤ₂ where
  toFun := orthchroMap
  map_one' := orthchroMap_IsOrthochronous (by simp [IsOrthochronous])
  map_mul' Λ Λ' := by
@ -189,5 +180,4 @@ def orthchroRep : LorentzGroup →* ℤ₂ where

 end LorentzGroup

-end SpaceTime
 end
--- a/HepLean/SpaceTime/LorentzGroup/Proper.lean
+++ b/HepLean/SpaceTime/LorentzGroup/Proper.lean
@ -14,7 +14,6 @@ We define the give a series of lemmas related to the determinant of the lorentz

 noncomputable section

-namespace SpaceTime

 open Manifold
 open Matrix
@ -23,10 +22,16 @@ 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 (Λ : 𝓛) : Λ.1.det = 1 ∨ Λ.1.det = -1 := by
-  simpa [← sq, det_one, det_mul, det_mul, det_mul, det_transpose, det_η] using
-    (congrArg det ((PreservesηLin.iff_matrix' Λ.1).mp Λ.2))
+lemma det_eq_one_or_neg_one (Λ : 𝓛 d) : Λ.1.det = 1 ∨ Λ.1.det = -1 := by
+  have h1 := (congrArg det ((mem_iff_self_mul_dual).mp Λ.2))
+  simp [det_mul, det_dual] at h1
+  exact mul_self_eq_one_iff.mp h1
+

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

@ -47,7 +52,7 @@ def coeForℤ₂ :  C(({-1, 1} : Set ℝ), ℤ₂) where
    exact continuous_of_discreteTopology

 /-- The continuous map taking a lorentz matrix to its determinant. -/
-def detContinuous :  C(𝓛, ℤ₂) :=
+def detContinuous :  C(𝓛 d, ℤ₂) :=
  ContinuousMap.comp  coeForℤ₂ {
    toFun := fun Λ => ⟨Λ.1.det, Or.symm (LorentzGroup.det_eq_one_or_neg_one _)⟩,
    continuous_toFun := by
@ -56,7 +61,7 @@ def detContinuous :  C(𝓛, ℤ₂) :=
        Continuous.comp' (continuous_iff_le_induced.mpr fun U a => a) continuous_id'
      }

-lemma detContinuous_eq_iff_det_eq (Λ Λ' : LorentzGroup) :
+lemma detContinuous_eq_iff_det_eq (Λ Λ' : LorentzGroup d) :
    detContinuous Λ = detContinuous Λ' ↔ Λ.1.det = Λ'.1.det := by
  apply Iff.intro
  intro h
@ -75,7 +80,7 @@ lemma detContinuous_eq_iff_det_eq (Λ Λ' : LorentzGroup) :

 /-- The representation taking a lorentz matrix to its determinant. -/
@[simps!]
-def detRep : 𝓛 →* ℤ₂ where
+def detRep : 𝓛 d →* ℤ₂ where
  toFun Λ := detContinuous Λ
  map_one' := by
    simp [detContinuous, lorentzGroupIsGroup]
@ -88,9 +93,9 @@ def detRep : 𝓛 →* ℤ₂ where
      <;> simp [h1, h2, detContinuous]
    rfl

-lemma detRep_continuous : Continuous detRep := detContinuous.2
+lemma detRep_continuous : Continuous (@detRep d) := detContinuous.2

-lemma det_on_connected_component {Λ Λ'  : LorentzGroup} (h : Λ' ∈ connectedComponent Λ) :
+lemma det_on_connected_component {Λ Λ'  : LorentzGroup d} (h : Λ' ∈ connectedComponent Λ) :
    Λ.1.det = Λ'.1.det := by
  obtain ⟨s, hs, hΛ'⟩ := h
  let f : ContinuousMap s ℤ₂ := ContinuousMap.restrict s detContinuous
@ -99,36 +104,35 @@ lemma det_on_connected_component {Λ Λ'  : LorentzGroup} (h : Λ' ∈ connected
    (@IsPreconnected.subsingleton ℤ₂ _ _ _ (isPreconnected_range f.2))
    (Set.mem_range_self ⟨Λ, hs.2⟩)  (Set.mem_range_self ⟨Λ', hΛ'⟩)

-lemma detRep_on_connected_component {Λ Λ'  : LorentzGroup} (h : Λ' ∈ connectedComponent Λ) :
+lemma detRep_on_connected_component {Λ Λ'  : LorentzGroup d} (h : Λ' ∈ connectedComponent Λ) :
    detRep Λ = detRep Λ' := by
  simp [detRep_apply, detRep_apply, detContinuous]
  rw [det_on_connected_component h]

-lemma det_of_joined {Λ Λ' : LorentzGroup} (h : Joined Λ Λ') : Λ.1.det = Λ'.1.det :=
+lemma det_of_joined {Λ Λ' : LorentzGroup d} (h : Joined Λ Λ') : Λ.1.det = Λ'.1.det :=
  det_on_connected_component $ pathComponent_subset_component _ h

 /-- A Lorentz Matrix is proper if its determinant is 1. -/
@[simp]
-def IsProper (Λ : LorentzGroup) : Prop := Λ.1.det = 1
+def IsProper (Λ : LorentzGroup d) : Prop := Λ.1.det = 1

-instance : DecidablePred IsProper := by
+instance : DecidablePred (@IsProper d) := by
  intro Λ
  apply Real.decidableEq

-lemma IsProper_iff (Λ : LorentzGroup) : IsProper Λ ↔ detRep Λ = 1 := by
+lemma IsProper_iff (Λ : LorentzGroup d) : IsProper Λ ↔ detRep Λ = 1 := by
  rw [show 1 = detRep 1 from Eq.symm (MonoidHom.map_one detRep)]
  rw [detRep_apply, detRep_apply, detContinuous_eq_iff_det_eq]
  simp only [IsProper, lorentzGroupIsGroup_one_coe, det_one]

-lemma id_IsProper : IsProper 1 := by
+lemma id_IsProper : (@IsProper d) 1 := by
  simp [IsProper]

-lemma isProper_on_connected_component {Λ Λ'  : LorentzGroup} (h : Λ' ∈ connectedComponent Λ) :
+lemma isProper_on_connected_component {Λ Λ'  : LorentzGroup d} (h : Λ' ∈ connectedComponent Λ) :
    IsProper Λ ↔ IsProper Λ' := by
  simp [detRep_apply, detRep_apply, detContinuous]
  rw [det_on_connected_component h]

 end LorentzGroup

-end SpaceTime
 end