In the computational mechanics software (Abaqus, Ansys, Comsol, etc), Voigt notation is always used to represent a symmetric tensor by reducing its order.
Now I would ask How can we get the Voigt Notation from second order tensor or fourth order tensor in a very efficient way in Mathematica.
e.g. second order tensor:
Array[Subscript[a, ## & @@ Sort[{##}]] &, {6, 6}] // MatrixForm
PS: 'using hand writing' is not a good way.
Reference Links: https://en.wikipedia.org/wiki/Voigt_notation
Assuming that, in general, the elements are ordered in a spiral:
ClearAll[voigtSpiral]
voigtSpiral = Module[{indices = Accumulate[
Join @@ ConstantArray @@@ Transpose[
{PadRight[{{1, 1}, {-1, 0}, {0, -1}}, {Length@#, 2}, "Periodic"],
Range[Length@#, 1, -1]}]]},
Extract[#, indices]] &;
Examples:
array[n_Integer] := Array[Subscript[a, ## & @@ Sort[{##}]] &, {n, n}]
voigtSpiral @ array @ 3 // TeXForm
$\small\left\{a_ {1, 1}, a_ {2, 2}, a_ {3, 3}, a_ {2, 3}, a_ {1, 3}, a_ {1, 2} \right\}$
voigtSpiral @ array @ 6 // TeXForm
$\small\left\{a_{1,1},a_{2,2},a_{3,3},a_{4,4},a_{5,5},a_{6,6},a_{5,6},a_{4,6},a_{3,6},a_{2,6},a_{1,6},a_{1,5},a_{1,4},a_{1,3},a_{1,2},a_{2,3},a_{3,4},a_{4,5},a_{3,5},a_{2,5},a_{2,4}\right\}$
Visualization:
pathGraph = PathGraph[voigtSpiral @ array @ #, DirectedEdges -> True,
VertexLabels -> Placed["Name", Center], VertexLabelStyle -> 20,
ImagePadding -> 20, VertexShapeFunction -> None,
VertexSize -> Scaled[.1], ImageSize -> 350,
VertexCoordinates -> (RotationTransform[-Pi/2] @
(voigtSpiral[array @ #] /. Subscript[_, x__] :> {x}))] &;
Grid[Partition[pathGraph /@ Range[2, 7], 3]]
Flatten[Diagonal[array[3], #] & /@ {0, 1, 2}]
$\endgroup$
Your question does not have a satisfactory answer unless you remove the requirement against a "manual" way.
First, let us define a function that will allow us to translate from {i,j} coordinates to k coordinates, where the i and j run from 1 to 3 and k runs from 1 to 6.
transf[u_] :=
Simplify[u.{{0, 3 - α}, {α, -3}}.u + {-10, 11}.u];
There, α is an arbitrary parameter. The call to Simplify is not necessary if you pick a value for α, say 0. In any case,
transf /@ {{1, 1}, {1, 2}, {1, 3}, {2, 2}, {2, 3}, {3, 3}}
yields
{1, 6, 5, 2, 4, 3}
Thus, we confirm transf is the mapping {i,j}↦k. Unfortunately, one cannot solve
k == transf[{i, j}]
(*k == (11 - 3 j) j + i (-10 + 3 j)*)
to get a "unique" inverse k↦{i,j}. For example, if we solve it for the diagonal entries:
Solve[k == transf[{i, i}], i]
(*{{i -> k}}*)
But for off-diagional entries in the third column:
Solve[k == transf[{i, 3}], i]
(*{{i -> 6 - k}}*)
So, the map k↦{i,j} will necessarily be a piece-wise function that will look as if it was coded by hand.
By the way, I will left it as an exercise for you to prove that the pullback k↦{i,j} is necessary to obtain the Voigt components out of the traditional ones.
If you decide to remove the requirement against "manual", then I would advise you to use Dispatch.
