Symbolic Output after numerical computation

Question

I have a small question about the symbolic output. I started to write a program that generates the coordinates of n-dimensional polytopes by Wythoff construction. For crystallographic groups, all is well, but for non-crystallographic groups, H2, H3 and H4 (5-fold symmetry) I have to use the golden ratio. The calculation operates. However, I would like the output of the golden ratio and its multiples is done by a symbol, for exemple $\tau$. There he has a way to do this without losing too much computational efficiency?

(*General setting*)
$RecursionLimit = Infinity;
    SetOptions[EvaluationNotebook[],
     CellEvaluationFunction ->
      (ToExpression[#, StandardForm,
         Function[
          Null,
          Module[{aborted = $Aborted},
           Internal`WithLocalSettings[
            Null,
            aborted = (ReleaseHold[Most[Hold[##]]]; Last[Hold[##]]),
            AbortProtect[
             If[aborted === $Aborted,
          Print["General Abort"]; Abort[]
          ]]]],
      HoldAll]] &)]

(*Constants*)
τ = (1 + Sqrt[5])/2;

(*Cartan Matrices*)
An[n_] := 
  Which[n == 1, {2}, n > 1, 
   Normal[SparseArray[{Band[{1, 1}] -> 2, Band[{2, 1}] -> -1, 
      Band[{1, 2}] -> -1}, n]]];
Bn[n_] := 
  Which[n == 1, {2}, n == 2, Normal[{{2, -1}, {-1, 2}}], n >= 3, 
   Normal[SparseArray[{Band[{1, 1}] -> 2, Band[{2, 1}] -> -1, 
      Band[{1, 2}, {n - 2, n - 1}] -> -1, {n - 1, n} -> -2}, n]]];
Cn[n_] := 
  Which[n == 1, {2}, n == 2, Normal[{{2, -1}, {-1, 2}}], n >= 3, 
   Normal[
    SparseArray[{Band[{1, 1}] -> 2, Band[{1, 2}] -> -1, 
      Band[{2, 1}, {n - 1, n - 1}] -> -1, {n, n - 1} -> -2}, n]]];
Dn[n_] := 
  Which[n == 1, {2}, 1 < n < 4, 
   Normal[SparseArray[{Band[{1, 1}] -> 2, Band[{2, 1}] -> -1, 
      Band[{1, 2}] -> -1}, n]], n >= 4, 
   Normal[SparseArray[{Band[{1, 1}] -> 2, 
      Band[{1, 2}, {n - 3, n - 2}] -> -1, 
      Band[{2, 1}, {n - 1, n}] -> -1, 
      Band[{n - 2, n - 2}] -> {{2, -1, -1}, {-1, 2, 0}, {-1, 0, 2}}}, 
     n]]];
En[n_] := 
  If[6 <= n <= 8, 
   Normal[SparseArray[{Band[{1, 1}] -> {{2, 0, -1, 0}, {0, 2, 
         0, -1}, {-1, 0, 2, -1}, {0, -1, -1, 2}}, Band[{4, 3}] -> -1, 
      Band[{3, 4}] -> -1, Band[{5, 5}] -> 2}, n]], 
   Print["This group doesn' t exist."] && Abort[]];
Fn[n_] := 
  If[n == 4, 
   Normal[{{2, -1, 0, 0}, {-1, 2, -2, 0}, {0, -1, 2, -1}, {0, 0, -1, 
      2}}], Print["This group doesn't exist. n = 4"] && Abort[]];
Gn[n_] := 
  If[n == 2, Normal[{{2, -3}, {-1, 2}}], 
   Print["This group doesn't exist. n = 2"] && Abort[]];
Hn[n_] := 
 Which[n == 2, Normal[{{2, -τ}, {-τ, 2}}], n == 3, 
  Normal[{{2, -1, 0}, {-1, 2, -τ}, {0, -τ, 2}}], n == 4, 
  Normal[{{2, -1, 0, 0}, {-1, 2, -1, 0}, {0, -1, 2, -τ}, {0, 
     0, -τ, 2}}], n == 1 || n > 4, 
  Print["This group doesn't exist."] && Abort[]]

(*Group selection function*)
selectGr[group_, dim_] := 
  Which[group == "An", An[dim], group == "Bn", Bn[dim], group == "Cn",
    Cn[dim], group == "Dn", Dn[dim], group == "En", En[dim], 
   group == "Fn", Fn[dim], group == "Gn", Gn[dim], group == "Hn", 
   Hn[dim]];

(*Reflection*)
reflect[vect_, group_] := Module[{dim, Gr, vectTemp},
   dim = Length[vect];
   Gr = selectGr[group, dim];
   For[i = 1, i <= dim, i++,
    vectTemp[i] = 
      If[vect[[i]] > 0, 
       FullSimplify[vect - vect[[i]]*Gr[[i]]], ## &[]];
    ];
   Return[Table[vectTemp[k], {k, 1, dim}]];
   ];
reflectAll[vect_, group_] := 
  DeleteDuplicates[
   Flatten[{vect, Flatten[reflect[#, group] & /@ vect, 1]}, 
    1], #1 == #2 &];


(*Positive elements*)
elemPos[vect_] := Positive@Max@vect;
(*elemAllPos[vect_]:=elemPos/@vect;
testPos[list1_,list2_]:=If[MemberQ[elemAllPos[Complement[list1,list2]]\
,True]\[Equal]True,True,False];*)


(*ω-basis coordinates*)

omegaCoor[vect_, group_] := (i = 2; j = 1; vtmp[1] = vect;
   While[True,
    vtmp[i] = reflectAll[vtmp[i - 1], group];
    If[elemPos[Last[vtmp[i]]] == False, Break[]]; i++; j++
    ]; 
   Return[{vtmp[i], group}]);

(*===============================================================================*)
(*Crash Test Dummies Zone*)
seed = {{0, 0, 1}};
coordinates = omegaCoor[seed, "Hn"];
Print[Length[coordinates[[1]]] "vertices"]
Print[coordinates[[1]]]
(*===============================================================================*)

The output will be :

(* 20 vertices *)
{{0,0,1},{0,1/2 (1+Sqrt[5]),-1},{1/2 (1+Sqrt[5]),1/2 (-1-Sqrt[5]),1/2 (1+Sqrt[5])},{1/2 (-1-Sqrt[5]),0,1/2 (1+Sqrt[5])},{1/2 (1+Sqrt[5]),1,1/2 (-1-Sqrt[5])},{1/2 (-1-Sqrt[5]),1/2 (3+Sqrt[5]),1/2 (-1-Sqrt[5])},{1/2 (3+Sqrt[5]),-1,0},{1,1/2 (-3-Sqrt[5]),1/2 (3+Sqrt[5])},{1/2 (-3-Sqrt[5]),1/2 (1+Sqrt[5]),0},{-1,1/2 (-1-Sqrt[5]),1/2 (3+Sqrt[5])},{1,1/2 (1+Sqrt[5]),1/2 (-3-Sqrt[5])},{-1,1/2 (3+Sqrt[5]),1/2 (-3-Sqrt[5])},{1/2 (3+Sqrt[5]),1/2 (-1-Sqrt[5]),0},{1/2 (1+Sqrt[5]),1/2 (-3-Sqrt[5]),1/2 (1+Sqrt[5])},{1/2 (-3-Sqrt[5]),1,0},{1/2 (-1-Sqrt[5]),-1,1/2 (1+Sqrt[5])},{1/2 (1+Sqrt[5]),0,1/2 (-1-Sqrt[5])},{1/2 (-1-Sqrt[5]),1/2 (1+Sqrt[5]),1/2 (-1-Sqrt[5])},{0,1/2 (-1-Sqrt[5]),1},{0,0,-1}}

Answer 1

EDIT

Here's a slightly modified version of a suggestion made by Kuba in my separate question on this topic

(coordinates[[1]] /. (Sqrt[5]) -> (2 tau - 1) // Simplify) /. tau -> HoldForm@\[Tau]

ORIGINAL

This is not the most elegant solution to grace this forum, but:

Map[
  If[
    AtomQ@#, 
    #, 
    (Simplify[#/τ]*HoldForm@τ) /. {
      τ -> HoldForm@τ, 
      -τ -> HoldForm@-τ}] &, 
   coordinates[[1]], {2}]