Principal Axes of a Volume

To determine the orientation of a volume segment in space, you can calculate the second central moments of its density distribution and derive the corresponding eigenvectors. Here is a short script to compute central moments and volume orientation.

Define a function that calculates the moments of an array.

 In[2]:= XarrayMoments[data_List, 0] := Total[data] arrayMoments[data_List, n_Integer?Positive] := (Range[0.5, Length[data] - 0.5]^n.data); arrayMoments[data_List, {ns__Integer?NonNegative}] := Fold[arrayMoments, data, {ns}]/Total[data, \[Infinity]];

Convert the volume into a data array with its indices aligned to the graphics coordinates.

 In[3]:= Xdata = ImageData[ ImageReflect[ImageReflect[tooth, Top -> Bottom], Front -> Back]];

Compute the first- and second-order moments of the tooth density.

 In[4]:= X\[Mu]s = Map[arrayMoments[data, #] &, Reverse@IdentityMatrix[3]];
 In[5]:= X{xx, yy, zz, xy, xz, yz} = Map[arrayMoments[data, Reverse@#] - Times @@ (\[Mu]s^#) &, {{2, 0, 0}, {0, 2, 0}, {0, 0, 2}, {1, 1, 0}, {1, 0, 1}, {0, 1, 1}}];

Compute the principal axes of the central moments matrix.

 In[6]:= X{vals, vecs} = Eigensystem[\!\(TraditionalForm\`\((\*GridBox[{ {xx, xy, xz}, {xy, yy, yz}, {xz, yz, zz} }, GridBoxAlignment->{ "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.7]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}}])\)\)]
 Out[6]=

Display the principal axes of the tooth.

 Out[7]=

Mathematica

Questions? Comments? Contact a Wolfram expert »