feat: Partial fromDualRep_tensor

HepLean/Tensors/TensorSpecies/Basic.lean

@@ -538,6 +538,24 @@ lemma evalMap_tprod {n : ℕ} {c : Fin n.succ → S.C} (i : Fin n.succ) (e : Fin
     LinearMap.id_coe, id_eq, TensorProduct.lid_tmul]
   rfl
 
+/-!
+
+## The equivalence turning vecs into tensors
+
+-/
+
+/-- The equivaelcne between tensors based on `![c]` and vectros in ` S.FD.obj (Discrete.mk c)`. -/
+def tensorToVec (c : S.C) : S.F.obj (OverColor.mk ![c]) ≅ S.FD.obj (Discrete.mk c) :=
+  OverColor.forgetLiftAppCon S.FD c
+
+lemma tensorToVec_inv_apply_expand (c : S.C) (x : S.FD.obj (Discrete.mk c)) :
+    (S.tensorToVec c).inv.hom x =
+    ((lift.obj S.FD).map (OverColor.mkIso (by
+    funext i
+    fin_cases i
+    rfl)).hom).hom ((OverColor.forgetLiftApp S.FD c).inv.hom x) :=
+  forgetLiftAppCon_inv_apply_expand S.FD c x
+
 end TensorSpecies
 
 end

HepLean/Tensors/TensorSpecies/ContractLemmas.lean

@@ -29,11 +29,11 @@ variable {S : TensorSpecies}
 def contrOneTwoLeft {c1 c2 : S.C}
     (x : S.F.obj (OverColor.mk ![c1])) (y : S.F.obj (OverColor.mk ![S.τ c1, c2])) :
     S.F.obj (OverColor.mk ![c2]) :=
-  (OverColor.forgetLiftAppCon S.FD c2).inv.hom <|
+  (S.tensorToVec c2).inv.hom <|
   (λ_ (S.FD.obj (Discrete.mk c2))).hom.hom <|
   ((S.contr.app (Discrete.mk c1)) ▷ (S.FD.obj (Discrete.mk (c2 )))).hom <|
   (α_ _ _ (S.FD.obj (Discrete.mk (c2 )))).inv.hom <|
-  (OverColor.forgetLiftAppCon S.FD c1).hom.hom (x) ⊗ₜ
+  (S.tensorToVec c1).hom.hom (x) ⊗ₜ
   (OverColor.Discrete.pairIsoSep S.FD).inv.hom y
 
 @[simp]
@@ -70,12 +70,12 @@ lemma contrOneTwoLeft_tprod_eq {c1 c2 : S.C}
     (fy : (i : (𝟭 Type).obj (OverColor.mk ![S.τ c1, c2]).left)
       → CoeSort.coe (S.FD.obj { as := (OverColor.mk ![S.τ c1, c2]).hom i })) :
     contrOneTwoLeft (PiTensorProduct.tprod S.k fx) (PiTensorProduct.tprod S.k fy) =
-      ((OverColor.forgetLiftAppCon S.FD c2).inv.hom (
+      ((S.tensorToVec c2).inv.hom (
      ((S.contr.app (Discrete.mk c1)).hom (fx (0 : Fin 1) ⊗ₜ fy (0 : Fin 2)) •
       fy (1 : Fin 2)))) := by
   rw [contrOneTwoLeft]
   apply congrArg
-  rw [Discrete.pairIsoSep_inv_tprod S.FD fy, OverColor.forgetLiftAppCon]
+  rw [Discrete.pairIsoSep_inv_tprod S.FD fy, tensorToVec, OverColor.forgetLiftAppCon]
   change (S.contr.app { as := c1 }).hom (_ ⊗ₜ[S.k] fy (0 : Fin 2)) • fy (1 : Fin 2) = _
   congr
   simp only [Equivalence.symm_inverse, Action.functorCategoryEquivalence_functor,
@@ -106,7 +106,7 @@ lemma contr_one_two_left_eq_contrOneTwoLeft_tprod {c1 c2 : S.C} (x : S.F.obj (Ov
   subst hy
   conv_rhs =>
     rw [contrOneTwoLeft_tprod_eq]
-    rw [OverColor.forgetLiftAppCon_inv_apply_expand]
+    rw [tensorToVec_inv_apply_expand]
   simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, Fin.succAbove_zero, mk_left,
     Functor.id_obj, mk_hom, contr_tensor, prod_tensor, Action.instMonoidalCategory_tensorObj_V,
     Equivalence.symm_inverse, Action.functorCategoryEquivalence_functor,
@@ -184,6 +184,17 @@ lemma contr_one_two_left_eq_contrOneTwoLeft {c1 c2 : S.C} (x : S.F.obj (OverColo
   simpa using contr_one_two_left_eq_contrOneTwoLeft_tprod (PiTensorProduct.tprod S.k fx)
     (PiTensorProduct.tprod S.k fy) fx fy
 
+/-- Expanding `contrOneTwoLeft` as a tensor tree. -/
+lemma contrOneTwoLeft_tensorTree {c1 c2 : S.C} (x : S.F.obj (OverColor.mk ![c1]))
+    (y : S.F.obj (OverColor.mk ![S.τ c1, c2])) :
+    (contrOneTwoLeft x y) = ({x | μ ⊗ y | μ ν}ᵀ |>
+      perm (OverColor.equivToHomEq (Equiv.refl _) (fun x => by fin_cases x; rfl ))).tensor := by
+  change (tensorNode (contrOneTwoLeft x y)).tensor = _
+  symm
+  rw [perm_eq_iff_eq_perm]
+  rw [contr_one_two_left_eq_contrOneTwoLeft]
+  rfl
+
 /-- Expands the inner contraction of two 2-tensors which are
   tprods in terms of basic categorical
   constructions and fields of the tensor species. -/

HepLean/Tensors/TensorSpecies/RepIso.lean

@@ -18,6 +18,7 @@ open MonoidalCategory
 noncomputable section
 
 namespace TensorSpecies
+open TensorTree
 variable (S : TensorSpecies)
 
 /-- The morphism from `S.FD.obj (Discrete.mk c)` to `S.FD.obj (Discrete.mk (S.τ c))`
@@ -43,8 +44,8 @@ def fromDualRep (c : S.C) : S.FD.obj (Discrete.mk (S.τ c)) ⟶ S.FD.obj (Discre
 
 /-- The rewriting of `toDualRep` in terms of `contrOneTwoLeft`. -/
 lemma toDualRep_apply_eq_contrOneTwoLeft (c : S.C) (x : S.FD.obj (Discrete.mk c)) :
-    (S.toDualRep c).hom x = (OverColor.forgetLiftAppCon S.FD (S.τ c)).hom.hom
-    (contrOneTwoLeft (((OverColor.forgetLiftAppCon S.FD c).inv.hom x))
+    (S.toDualRep c).hom x = (S.tensorToVec (S.τ c)).hom.hom
+    (contrOneTwoLeft (((S.tensorToVec c).inv.hom x))
     (S.metricTensor (S.τ c))) := by
   simp only [toDualRep, Monoidal.tensorUnit_obj, Action.comp_hom,
     Action.instMonoidalCategory_tensorObj_V, Action.instMonoidalCategory_tensorUnit_V,
@@ -59,6 +60,29 @@ lemma toDualRep_apply_eq_contrOneTwoLeft (c : S.C) (x : S.FD.obj (Discrete.mk c)
   erw [pairIsoSep_inv_metricTensor]
   rfl
 
+/-- Expansion of `toDualRep` is
+  `(S.tensorToVec c).inv.hom x | μ ⊗ S.metricTensor (S.τ c) | μ ν`. -/
+lemma toDualRep_tensorTree (c : S.C) (x : S.FD.obj (Discrete.mk c)) :
+    let y : S.F.obj (OverColor.mk ![c]) := (S.tensorToVec c).inv.hom x
+    (S.toDualRep c).hom x = (S.tensorToVec (S.τ c)).hom.hom
+    ({y | μ ⊗ S.metricTensor (S.τ c) | μ ν}ᵀ
+    |> perm (OverColor.equivToHomEq (Equiv.refl _) (fun x => by fin_cases x; rfl ))).tensor := by
+  simp only
+  rw [toDualRep_apply_eq_contrOneTwoLeft]
+  apply congrArg
+  exact contrOneTwoLeft_tensorTree ((S.tensorToVec c).inv.hom x) (S.metricTensor (S.τ c))
+
+lemma fromDualRep_tensorTree (c : S.C) (x : S.FD.obj (Discrete.mk (S.τ c))) :
+    let y : S.F.obj (OverColor.mk ![S.τ c]) := (S.tensorToVec (S.τ c)).inv.hom x
+    (S.fromDualRep c).hom x = (S.tensorToVec c).hom.hom
+    ({y | μ ⊗ S.metricTensor (S.τ (S.τ c))| μ ν}ᵀ
+    |> perm (OverColor.equivToHomEq (Equiv.refl _) (fun x => by fin_cases x; exact (S.τ_involution c).symm ))).tensor := by
+  simp only
+  rw [fromDualRep]
+  simp only [Action.comp_hom, ModuleCat.coe_comp, Function.comp_apply, Nat.succ_eq_add_one,
+    Nat.reduceAdd, Fin.isValue, Fin.succAbove_zero]
+  rw [toDualRep_tensorTree]
+
 end TensorSpecies
 
 end

HepLean/Tensors/TensorSpecies/UnitTensor.lean

@@ -121,7 +121,7 @@ lemma contrOneTwoLeft_unitTensor  {c1 : S.C} (x : S.F.obj (OverColor.mk ![c1]))
     Action.instMonoidalCategory_whiskerRight_hom, Functor.comp_obj, Discrete.functor_obj_eq_as,
     Function.comp_apply, Action.instMonoidalCategory_associator_inv_hom, Equivalence.symm_inverse,
     Action.functorCategoryEquivalence_functor, Action.FunctorCategoryEquivalence.functor_obj_obj,
-    forgetLiftAppCon_inv_apply_expand]
+    tensorToVec_inv_apply_expand]
   erw [pairIsoSep_inv_unitTensor (S := S) (c := c1)]
   change (S.F.mapIso (mkIso _)).hom.hom _ = _
   rw [Discrete.rep_iso_apply_iff, Discrete.rep_iso_inv_apply_iff]

HepLean/Tensors/Tree/Elab.lean

@@ -195,8 +195,10 @@ def getNoIndicesExact (stx : Syntax) : TermElabM ℕ := do
         let a' ← whnf a
         match a' with
         | Expr.lit (Literal.natVal n) => return n
-        |_ => throwError "Could not extract number of indices from tensor (getNoIndicesExact). "
-      | _ => throwError "Could not extract number of indices from tensor (getNoIndicesExact). "
+        |_ => throwError s!"Could not extract number of indices from tensor
+          {stx} (getNoIndicesExact). "
+      | _ => throwError s!"Could not extract number of indices from tensor
+        {stx} (getNoIndicesExact). "
     | _ => return 1
   | k => return k