4
$\begingroup$

In addition to my previous post, regarding plotting the surface of a Möbius strip, I now realised, that some of the eigenmodes for a Möbius strip are either oscillations of a scalar field OR a vector field, meaning that not all eigenmodes of this object can be shown in 3D as wobbles in the direction normal to the surface, because the Möbius strip is not orientable, like a cylinder is.

Now that I have learned this fact, I have to do the following:

  1. Represent all transversal oscillations as wobbles in the direction normal to the surface. This means that these are oscillations of a vector field with only one component. This has been successfully done with the help in my previous question.

  2. I need to represent all the longitudinal oscillations as oscillations of a scalar field, which is usually done by showing changes of color on an object, like shown in this example for a cylinder: cylinder example

Problem

I would like to plot 4D data $(x,y,z,F)$ as a set of polygons that have been made using DelaunayTriangulation[] of a 2D mesh in 3D using Graphics3Dfor the case of a Möbius strip, where $(x,y,z)$ are the data points and $F$ is the color.

In my previous question I noted that ListSurfacePlot3D and ListPlot3D are not working properly for the case of the Möbius strip. The solution was to plot the strip as a set of polygons, generated by the mesh. A uniformly colored polygon surface looks like this: Möbius strip

What I want

I would like to color these polygons with the color equal to the average value of $F$ for the surrounding 3 points.

Here is the provided data and code

Original 2D data of a rectangular $[0,1]\times[0,1]$ membrane:

data2D = Import["https://pastebin.com/raw/0Liw8F1r", "NB"];

Transformed 4D data parametrised as a Möbius strip with color data as the 4th column:

data4D = Import["https://pastebin.com/raw/zgrCRiQh", "NB"];

The code to draw the strip without the color data $F$:

tri = First @ Cases[ListDensityPlot[Join[#, {0}] & /@ data2D], 
                    Polygon[idx_] :> idx, Infinity];    

Graphics3D[GraphicsComplex[data4D[[;; , 1 ;; 3]], {Yellow, EdgeForm[], Polygon /@ tri}], 
           Boxed -> False, AspectRatio -> 1, BoxRatios -> Automatic, 
           SphericalRegion -> True, , ImageSize -> Large,
           PlotRange -> 0.9 {{-1, 1}, {-1, 1}, {-0.5, 0.5}}]

I tried to find some answers before posting the question, but all solutions had either discrete points or smooth plots in 3D, and I need to color the specific polygons.

Thank you all for your help, I hope that the problem is clearly stated.

$\endgroup$
6
$\begingroup$

Something like this?

data2D = Import["http://pastebin.com/raw.php?i=0Liw8F1r", "NB"];
data4D = Import["http://pastebin.com/raw.php?i=zgrCRiQh", "NB"];

Find min and max values for the color data

{min, max} = {Min[#], Max[#]} &@data4D[[All, -1]];

Now, I place a color in front of each polygon (like {color1, polygon1, color2, polygon2, ...}) when specifying the graphics used by GraphicsComplex. The color1 is the average of the color data (according to data4D) specified at each vertex of polygon1.

Labeled[Graphics3D[
  GraphicsComplex[
   data4D[[;; , 1 ;; 3]], {EdgeForm[], 
    Map[{ColorData["DarkRainbow"][
        Rescale[Mean[Part[data4D, #1, -1]], {min, max}]], 
       Polygon[#1]} &, tri]}], Boxed -> False, AspectRatio -> 1, 
  BoxRatios -> Automatic, SphericalRegion -> True, 
  PlotRange -> 0.9 {{-1, 1}, {-1, 1}, {-0.5, 0.5}}, 
  ImageSize -> Large], 
 BarLegend[{"DarkRainbow", {min, max}}], Right]

enter image description here

$\endgroup$
  • $\begingroup$ Great! This is exactly what I wanted. I had trouble getting the point data from the corresponding indices in a certain polygon. Thank's a lot! $\endgroup$ – MasterApprentice Jul 9 '14 at 17:19
  • $\begingroup$ Is it just me, or does this take a lot of time to plot? EDIT: Oh, nevermind, found the typo! $\endgroup$ – MasterApprentice Jul 9 '14 at 17:24
  • $\begingroup$ Is there a way to include interpolation though? Or somehow remove the shading on this polygons? $\endgroup$ – MasterApprentice Jul 9 '14 at 22:37
2
$\begingroup$

Nowadays, one can use DelaunayMesh[] directly for mesh triangulation instead of ListDensityPlot[]:

data2D = Import["http://pastebin.com/raw.php?i=0Liw8F1r", "NB"];
data4D = Import["http://pastebin.com/raw.php?i=zgrCRiQh", "NB"];

pts = Drop[data4D, None, -1];

dm = DelaunayMesh[data2D];
tri = First /@ MeshCells[dm, 2];

nrms = Table[Flatten[Last[SingularValueDecomposition[Standardize[pts[[t]], Mean, 1 &],
                                                     -1, Tolerance -> 0]]], {t, tri}];

vc = ColorData["DarkRainbow"] /@ Rescale[data4D[[All, -1]]];
vn = Table[Normalize[Mean[nrms[[id]]]], {id, dm["VertexFaceConnectivity"]}];

Graphics3D[GraphicsComplex[pts, {EdgeForm[], Polygon[tri2]},
                           VertexColors -> vc, VertexNormals -> vn],
           Boxed -> False, Lighting -> "Neutral",
           PlotRange -> 0.9 {{-1, 1}, {-1, 1}, {-0.5, 0.5}}, SphericalRegion -> True]

colored Möbius strip

The clash of bright and dark colors is due to the nonorientability, which is manifested in the directions of the estimated normals. (See this answer for another illustration.)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.