Shell Grid Patterns with gridMathematica

An Application Based on Stephen Wolfram's A New Kind of Science

Based on code submitted by Ed Pegg and Jeff Bryant

Initialization

<< Parallel`Parallel`

\(multipleLaunchSlave[machToUse_, 
        slavPerKernel_] := \(Do[
node = 
              StringJoin["xserve", \ 
                ToString[
                  nodenum]]; 
Do[
LaunchSlave[
                node, \ "/usr/bin/rsh `1` /usr/local/bin/math -mathlink"], 
{#2}
], 
{nodenum, \ 1, \ #1}
] &\)[machToUse, 
        slavPerKernel]\)

multipleLaunchSlave[8, 2]

\(TableForm[
      RemoteEvaluate[{$ProcessorID, $MachineName, $SystemID, $ProcessID, $Version}], 
      TableHeadings -> {None, {"ID", "host", "OS", "process", "Mathematica Version"}}]\)

Definitions

RemoteEvaluate[
        simpleshellTable[{revs_:  5, plotPointsPerRev_:  23.11, 
              plotPointsPerCircle_:  19.23, circleStartAngle_: - π, 
              circleEndAngle_:  π, omittedRevs_:  0}, growthPerRev_, 
            mouthCenterAngleFromVertical_, {mouthPerRadius_:  1, 
              radialHook_:  0}, {verticalStretch_:  1, stretchAngle_:  0, 
              verticalHook_:  0}] := 
          Table[({Cos[spiralAngle], Sin[spiralAngle], 
                      0} (1 + 
                        mouthPerRadius (Cos[circleAngle] 
                                Cos[stretchAngle] + 
                              Sin[stretchAngle] Sin[circleAngle] 
                                verticalStretch)) 
                    Sin[mouthCenterAngleFromVertical] + {0, 
                    0, -Cos[mouthCenterAngleFromVertical]} + {0, 0, 
                    Sin[mouthCenterAngleFromVertical] 
                      mouthPerRadius (verticalStretch Sin[circleAngle] 
                            Cos[stretchAngle] - 
                          Sin[stretchAngle] Cos[circleAngle])})/
              growthPerRev^(spiralAngle/2/π), {circleAngle, 
              circleStartAngle, 
              circleEndAngle, (circleEndAngle - circleStartAngle)/
                plotPointsPerCircle}, {spiralAngle, omittedRevs, 
              2  π revs, 2  π/plotPointsPerRev}]];

RemoteEvaluate[
        apts = Round[
            10000 simpleshellTable[{1.5, 120, 360, -Pi, Pi/2, 0}, 
                1.35,  .3, { .6, 0}, {3, 0, 0}]]];

RemoteEvaluate[
        vectormod  = 
          Round[Map[(Max[#] + Min[#])/2  &, 
              Transpose[Flatten[apts, 1]]]]];

RemoteEvaluate[
        apts2  =  Map[# - vectormod  &, apts, {2}]];

RemoteEvaluate[
        aptsB = Round[
            10000 simpleshellTable[{8.5, 90, 360/6, Pi/4, Pi/2, 1.5*2  Pi}, 
                1.35,  .3, { .6, 0}, {3, 0, 0}]]];

RemoteEvaluate[
        apts2B  =  Map[# - vectormod  &, aptsB, {2}]];

Parallelization

\(ParallelTable[
      Export["/gridshare/shellfine" <> If[n < 10, "0", ""] <> 
          ToString[
            n] <> ".tif", 
With[{myca = 
              Map[Reverse, 
                Transpose[
                  Take[CellularAutomaton[{1911, {3, 1}, 2}, {{1}, 0}, 
                      1000], {1, 1000}, {1500, 
                      2500}]]]}, 
Graphics3D[{
Table[{FaceForm[
                    SurfaceColor[RGBColor[0.933333, \ 0.901961, \ 0.756863]], 
                    SurfaceColor[{RGBColor[207/255, 164/255, 78/255], 
                          RGBColor[229/255, 213/255, 164/255], 
                          RGBColor[120/255, 64/255, 4/255], 
                          RGBColor[194/255, 119/255, 
                            6/255]}[\([myca[\([a, b]\)] + 1]\)]]], 
                  EdgeForm[], 
                  Polygon[{apts2[\([a, b]\)], apts2[\([a + 1, b]\)], 
                      apts2[\([a + 1, b + 1]\)], 
                      apts2[\([a, b + 1]\)]}]}, {a, 
                  1, \(Dimensions[apts2]\)[\([1]\)] - 
                    1}, {b, \((27 - n)\), \(Dimensions[apts2]\)[\([2]\)] - 
                    1}], 
RGBColor[0, 0, 
                0], 
AbsoluteThickness[
                2], 
Line[
                Table[apts2[\([a, \((27 - n)\)]\)], {a, 
                    1, \(Dimensions[apts2]\)[\([1]\)] - 
                      1}]], 
Table[{FaceForm[
                    SurfaceColor[RGBColor[0.933333, \ 0.901961, \ 0.756863]], 
                    SurfaceColor[{RGBColor[207/255, 164/255, 78/255], 
                          RGBColor[229/255, 213/255, 164/255], 
                          RGBColor[120/255, 64/255, 4/255], 
                          RGBColor[194/255, 119/255, 
                            6/255]}[\([myca[\([a, b]\)] + 1]\)]]], 
                  EdgeForm[], 
                  Polygon[{apts2B[\([a, b]\)], apts2B[\([a + 1, b]\)], 
                      apts2B[\([a + 1, b + 1]\)], 
                      apts2B[\([a, b + 1]\)]}]}, {a, 
                  1, \(Dimensions[apts2B]\)[\([1]\)] - 1}, {b, 
                  1, \(Dimensions[apts2B]\)[\([2]\)] - 
                    1}], 
RGBColor[1, 1, 
                1], 
Point[{\(-4374\), \(-4057\), \(-6074\)}], Point[{4374, 4057, 6074}]
}, 
            Boxed -> False, \ PlotRange -> All, 
            ViewVertical -> {0, 1, 0}, 
            ViewPoint -> {3.0, \ 1.000, \ 0}]], "TIFF", 
        ImageSize -> \ 1280], {n, 1, 26}]\)

Now that all of the frames have been created and exported, they can be assembled into an animation.

CloseSlaves[];