# Discrete Inertia Tensor

I want to write a code that calculates the eigenvectors of the Inertia Tensor and then shows me the object and the main axis for rotation. I only consider discrete mass distribution. This is my Code for an arbitrary object. In order to calculate for a concrete object, just adjust the lists:

PVL:=List[{Subscript[x, 1,1],Subscript[x, 1,2],Subscript[x, 1,3]},{Subscript[x, 2,1],Subscript[x, 2,2],Subscript[x, 2,3]}];
ML:=List[Subscript[m, 1],Subscript[m, 2]];
R=Total[Times[PVL,ML]]/Total[ML];R//MatrixForm
Θ:=Sum[Part[ML,α]( Norm[(Part[PVL,α]-R)]^2 KroneckerDelta[i,j]-Part[Part[PVL,α],j]*Part[Part[PVL,α],i]),{α,Length[ML]}];
Ξ=Table[Θ,{i,3},{j,3}];Ξ//MatrixForm

S=Eigensystem[N[Ξ,10]];S//MatrixForm

Graphics3D[{PointSize[Medium],Blue,Point[PVL],
PointSize[Large],Red,Point[R],
Blue,Line[Tuples[Table[PVL,Length[PVL]]]],
Purple,Arrow[{R,R+Part[Part[S,2],1]}],Arrow[{R,R+Part[Part[S,2],2]}],Arrow[{R,R+Part[Part[S,2],3]}]}]


How could I get the pointsize of a particular point to represent its mass-proportion compared to the whole mass? Is there a better way to connect the dots to show the contours of my object? How can I get a straight line thru the object, instead of vectors, which only point in one direction.

Thanks for the help.

Here's a few simple additions. The volume of the points is now proportional to their masses, the lines connecting the points have been somewhat thickened, and the eigenvectors of the moment of inertia tensor have been extended in both directions.

PVL:=List[{Subscript[x, 1,1],Subscript[x, 1,2],Subscript[x, 1,3]},{Subscript[x, 2,1],Subscript[x, 2,2],Subscript[x, 2,3]}];
ML:=List[Subscript[m, 1],Subscript[m, 2]];

TotalMass = Total[ML]
MaxSpan = Max[Table[EuclideanDistance[i, j], {i, PVL}, {j, PVL}]]

R = Total[PVL ML]/TotalMass; MatrixForm[R]
Θ := Sum[ML[[α]]*(Norm[PVL[[α]] - R]^2*
KroneckerDelta[i, j] - PVL[[α]][[j]]*PVL[[α]][[i]]),
{α, Length[ML]}]
Ξ =
Table[Θ, {i, 3}, {j, 3}]; MatrixForm[Ξ]
S = Eigensystem[N[Ξ, 10]]; MatrixForm[S]

pointgraphics = Table[
{PointSize[1/4 (ML[[i]]/TotalMass)^(1/3)/MaxSpan], Blue,
Point[PVL[[i]]]}
, {i, 1, Length[PVL]}
];
centerofmassgraphic = {PointSize[(1/4) /MaxSpan], Red, Point[R]};
structurelinesgraphics = {Blue, Thick,
Line[Tuples[Table[PVL, Length[PVL]]]]};
eigenvectorsgraphics = {Purple, Dashed,
Line[{R - 2 S[][], R + 2 S[][]}],
Line[{R - 2 S[][], R + 2 S[][]}],
Line[{R - 2 S[][], R + 2 S[][]}]};

Graphics3D[
{pointgraphics, centerofmassgraphic, structurelinesgraphics,
eigenvectorsgraphics},
Axes -> True, AxesLabel -> {x, y, z}
]

• Thanks for your answer! See here for advice on copying things like the summation symbol. +1 – jjc385 Feb 12 '18 at 1:52
• Thank you so much. This seems so complicated. How did you figure this additional code out? – M. K. Feb 23 '18 at 19:32
• My changes were not particularly inspired, but Mathematica code can look a little opaque. You had set the PointSize of the vertices to be Medium, but I changed it to be proportional to their size if they were constant-density objects. Then I just changed a few other options and factored out the graphics objects from the Graphics3D function to make things cleaner. – Daniel Martin Feb 24 '18 at 15:43