WOLFRAM NOTEBOOK

Ellipsoid Mesh

Ellipsoid

In[]:=
makeEllipsoidCode[a_,b_,c_,resolution_]:=StringTemplate[​​"cd(\"`6`\")\n"<>​​"fd=@(p) p(:, 1).^2 / `1`^2 + p(:, 2).^2 / `2`^2 + p(:, 3).^2 / `3`^2 - 1;\n"<>​​"[p, t] = distmeshsurface(fd, @huniform, `4`, [-1.1 * `1`, -1.1 * `2`, -1.1 * `3`; 1.1 * `1`, 1.1 * `2`, 1.1 * `3`]);\n"<>​​"writematrix(p, \"`5`/points.txt\");\n"<>​​"writematrix(t, \"`5`/triangles.txt\");"][a,b,c,resolution,$TemporaryDirectory,FileNameJoin[{$Dropbox,"Physics/CodeDevelopment/ExternalCode/distmesh"}]]
In[]:=
makeEllipsoidCode[1,2,3,0.05]
Out[]=
cd("/Users/maxitg/Dropbox (Wolfram)/Physics/CodeDevelopment/ExternalCode/distmesh")fd=@(p) p(:, 1).^2 / 1^2 + p(:, 2).^2 / 2^2 + p(:, 3).^2 / 3^2 - 1;[p, t] = distmeshsurface(fd, @huniform, 0.05, [-1.1 * 1, -1.1 * 2, -1.1 * 3; 1.1 * 1, 1.1 * 2, 1.1 * 3]);writematrix(p, "/private/var/folders/pz/q1ty3f9x1yq5f2ppwrkhgz4r0000gn/T/points.txt");writematrix(t, "/private/var/folders/pz/q1ty3f9x1yq5f2ppwrkhgz4r0000gn/T/triangles.txt");
In[]:=
getEllipsoid[]:=With[{points=Import[FileNameJoin[{$TemporaryDirectory,"points.txt"}],"CSV"],triangles=Import[FileNameJoin[{$TemporaryDirectory,"triangles.txt"}],"CSV"]},With[{simpleGraph=SimpleGraph[UndirectedEdge@@@Catenate[Partition[#,2,1,-1]&/@triangles]]},Graph3D[simpleGraph,VertexCoordinatespoints〚VertexList[simpleGraph]〛]]]
In[]:=
sphere=getEllipsoid[];
In[]:=
sphere=
Graph[
]
;
In[]:=
ellipsoid123=
Graph[
]
;

Ricci Scalar

In[]:=
ricciScalar[graph_]:=With{volumes=GraphNeighborhoodVolumes[graph]},
6(2+2)
2
Range[Length[#]-1]
1-
Rest[#]
π
2
Range[Length[#]-1]
&/@(Take[#,Min[Length/@volumes]]&)/@volumes
In[]:=
2
2
(GraphDiameter[sphere]/π)
//N
Out[]=
0.0152309
In[]:=
ricciScalarPlot[graph_,opts___]:=ListPlot[MeanAround/@Transpose[Values[ricciScalar[graph]]],opts]
In[]:=
ricciScalarPlot[sphere,PlotRange{All,{-0.01,0.02}}]
Out[]=
In[]:=
2
2
(GraphDiameter[ellipsoid123]/π)
//N
Out[]=
0.0129778
In[]:=
2
2
(GraphDiameter[ellipsoid123]/3/π)
//N
Out[]=
0.1168
In[]:=
ricciScalarEllipsoid=N[ricciScalar[ellipsoid123]];
In[]:=
ricciScalarSphere=N[ricciScalar[sphere]];
In[]:=
Take[ReverseSort[Max/@ricciScalarEllipsoid],10]
Out[]=
110.0329713,610.0322073,17140.0299571,150.0299155,170.0287674,17190.0285113,20.0285113,10.0277988,130.0277238,230.027202
In[]:=
ListPlot[ricciScalarEllipsoid[11],JoinedTrue,PlotRange{All,{-0.01,All}}]
Out[]=
0
5
10
15
20
25
-0.01
0.01
0.02
0.03
In[]:=
Take[Sort[ricciScalarEllipsoid〚All,10〛],10]
Out[]=
946-0.0342558,1004-0.0342558,385-0.0334919,1256-0.0334919,506-0.0327279,1008-0.0327279,1127-0.0327279,1184-0.0327279,1333-0.0327279,325-0.031964
In[]:=
Normal[Sort[ricciScalarEllipsoid〚All,10〛]]〚1728/2〛
Out[]=
1508-0.0098096
The position on the ellipsoid with the largest curvature
In[]:=
HighlightGraph[ellipsoid123,NeighborhoodGraph[ellipsoid123,11,1],GraphHighlightStyle"Thick"]
Out[]=
The smallest curvature
In[]:=
HighlightGraph[ellipsoid123,NeighborhoodGraph[ellipsoid123,946,1],GraphHighlightStyle"Thick"]
Out[]=
In the middle

Orthogonal Directions

Geodesic Bundles in orthogonal directions

Cylinder growth

Longer tubes

Ball growth

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.