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,3,3,0.15]
Out[]=
cd("/Users/maxitg/Dropbox (Wolfram)/Physics/CodeDevelopment/ExternalCode/distmesh")fd=@(p) p(:, 1).^2 / 1^2 + p(:, 2).^2 / 3^2 + p(:, 3).^2 / 3^2 - 1;[p, t] = distmeshsurface(fd, @huniform, 0.15, [-1.1 * 1, -1.1 * 3, -1.1 * 3; 1.1 * 1, 1.1 * 3, 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[]:=
ellipsoid133=getEllipsoid[];
In[]:=
sphere=
Graph[
]
;
In[]:=
ellipsoid123=
Graph[
]
;
In[]:=
ellipsoid113=
Graph[
]
;
In[]:=
ellipsoid133=
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[]:=
ricciScalarPlot[graph_,opts___]:=ListPlot[MeanAround/@Transpose[Values[ricciScalar[graph]]],opts]
In[]:=
ricciScalarEllipsoid=N[ricciScalar[ellipsoid133]];
In[]:=
Take[ReverseSort[Max/@ricciScalarEllipsoid],10]
Out[]=
35550.0187665,150.0133542,35590.0121898,34530.0110267,27810.010459,38500.00989376,31850.00944099,1570.0090753,39520.00903277,38540.00903277
In[]:=
ListPlot[ricciScalarEllipsoid[3555],JoinedTrue,PlotRange{All,{-0.01,All}}]
Out[]=
10
20
30
40
-0.010
-0.005
0.005
0.010
0.015
0.020
In[]:=
Take[Sort[ricciScalarEllipsoid〚All,10〛],10]
Out[]=
2634-0.0396034,2179-0.0388395,2375-0.0388395,2753-0.0388395,2286-0.0373116,2598-0.0373116,1300-0.0365476,1946-0.0365476,1970-0.0365476,1972-0.0365476
In[]:=
VertexCount[ellipsoid133]
Out[]=
4150
In[]:=
Normal[Sort[ricciScalarEllipsoid〚All,10〛]]〚4150/2〛
Out[]=
3049-0.0166851
The position on the ellipsoid with the largest curvature
In[]:=
HighlightGraph[ellipsoid133,NeighborhoodGraph[ellipsoid133,3555,1],GraphHighlightStyle"Thick"]
Out[]=
The smallest curvature
In[]:=
HighlightGraph[ellipsoid133,NeighborhoodGraph[ellipsoid133,2634,1],GraphHighlightStyle"Thick"]
Out[]=
In the middle
In[]:=
HighlightGraph[ellipsoid133,NeighborhoodGraph[ellipsoid133,3049,1],GraphHighlightStyle"Thick"]
Out[]=

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.