16
$\begingroup$

How do I plot a shape made from revolving the Koch Snowflake?

I try to use RevolutionPlot3D[f, {t, t1}], but I think there is no $f$ for the Koch Snowflake.

$\endgroup$
19
$\begingroup$

From a quick Google search I found Rob Lockhart's Wolfram Demonstration which plays around with this shape:

Koch Snowflake Demo

To save time, here are his definitions:

TRI2 = {{-1, 0}, {0, Sqrt[3]}, {1, 0}, {-1, 0}} // N;
INTRI2 = Reverse[TRI2];
SQU2 = {{-1, 1}, {1, 1}, {1, -1}, {-1, -1}, {-1, 1}} // N;
INSQU2 = Reverse[SQU2];
TriRule2 = 
  Flatten[Partition[#, 2, 1] 
  /. {{c_, d_}, {a_, b_}} -> {{c, d}, {c + ((a - c)/3), 
     d + ((b - d)/3)}, {(c + ((a - c)/2)) - (1/(2*Sqrt[3]))*
     (b - d), (d + ((b - d)/2)) + (1/(2*Sqrt[3]))*(a - 
        c)}, {a - ((a - c)/3), b - ((b - d)/3)}, {a, b}}, 1] &;

SquRule2 = 
  Flatten[Partition[#, 2, 1] 
  /. {{c_, d_}, {a_, b_}} -> {{c, d}, {c + ((a - c)/3), 
    d + ((b - d)/3)}, {((c + ((a - c)/3)) - (1/3)*(b - d)), 
    ((d + ((b - d)/3)) + (1/3)*(a - c))}, {(a - ((a - c)/3)) - (1/3)*
    (b - d), (b - ((b - d)/3)) + (1/3)*(a - c)}, {a - ((a - c)/3), 
    b - ((b - d)/3)}, {a, b}}, 1] &;

Then, using the base case, we'll make a line:

l = Line[Append[#, 0] & /@ Nest[TriRule2, TRI2, 3]];

Then we need to know where to rotate about:

xMidPoint = (Max[l[[All, 1]] /. Line -> Identity] + 
    Min[l[[All, 1]] /. Line -> Identity])/2
yMidPoint = (Max[l[[All, 2]] /. Line -> Identity] + 
    Min[l[[All, 2]] /. Line -> Identity])/2

(we're only using the y for the rotation)

Then we rotate the line:

Table[GeometricTransformation[l, 
  RotationTransform[k Degree , {0, yMidPoint, 0}]], {k, 1, 180}]

snow1

enter image description here

Full gif code:

gif = Table[
   Graphics3D[
    Table[GeometricTransformation[l, 
    RotationTransform[k Degree , {0, yMidPoint, 0}]], {k, 1, i}], 
    PlotRange -> {-1, 1}, ViewPoint -> Above], {i, 1, 180, 2}];

Export["p2.gif", Rasterize /@ gif]
$\endgroup$
16
$\begingroup$

Here's an overly detailed way to go about it. The extra detail will allow us to numerically approximate the volume of the object.

First, here is some code that generates some approximations to the solid Koch snowflake.

level = 4;
Clear[triangles];
triangles[1] = Join[
   Table[{{0, 0}, {Cos[t], Sin[t]}, {Cos[t + Pi/3], 
      Sin[t + Pi/3]}}, {t, 0, 2 Pi - Pi/3, Pi/3}],
   Table[{{Cos[t], 
      Sin[t]}, {Cos[t], Sin[t]} + {Cos[t + Pi/3], Sin[t + Pi/3]},
     {Cos[t + Pi/3], Sin[t + Pi/3]}}, {t, 0, 2 Pi - Pi/3, Pi/3}]
   ];
edges = Table[{{Cos[t], Sin[t]}, {Cos[t + Pi/3], Sin[t + Pi/3]}}, 
  {t, 0, 2*Pi-Pi/3, Pi/3}];
edges = Flatten[{{#[[1]], #[[2]] + #[[1]]}, 
  {#[[2]] + #[[1]], #[[2]]}} & /@ edges, 1];
Do[
 triangles[n] = {};
 edges = Flatten[edges /. {s_, f_} :> (triangles[n] = 
       {triangles[n], 
        tri[2 s/3 + f/3, 
         2 s/3 + f/3 + RotationMatrix[-Pi/3].(f - s)/3, 
         s/3 + 2 f/3]};
      {{s, 2 s/3 + f/3},
       {2 s/3 + f/3, 2 s/3 + f/3 + RotationMatrix[-Pi/3].(f - s)/3},
       {2 s/3 + f/3 + RotationMatrix[-Pi/3].(f - s)/3, s/3 + 2 f/3},
       {s/3 + 2 f/3, f}}), 1];
 triangles[n] = 
  Cases[triangles[n], tri[a_, b_, c_] :> {a, b, c}, Infinity],
 {n, 2, level}]

Note that this generates triangles at various levels which are stored in the variable triangles[n] where n can assume the values 1 through the variable level. We can show the result and distinctly shade the triangles at the various levels as follows:

Graphics[{
  Table[{Darker[LightGray, 1-1/2^(k-1)], EdgeForm[{Thin, Black}], 
    Polygon[triangles[k]]}, {k, 1, level}],
  {Blue, Line[edges]}}]

To fully illustrate what's going on here, let's examine the result for level=1, level=2, level=3, and level=4.

enter image description here

Thus, you can see that level 1 is a basic first order approximation to the Koch snowflake. Level $n$ is obtained from level $n-1$ by slapping on some new triangles. Importantly, the existing triangles are left alone.

Now, your primary question involves the revolution of this thing about an axis. As you don't specify the axis, I'll assume it to be the $x$-axis. Note that edges, at this point, consists of $768$ point pairs that define the individual segments of the Koch snowflake. They are shown in blue in the figure above and appear to be single complicated boundary. So, here's a function that revolves a segment from start s to finish f around the $x$-axis, together with a function that does the same for a single point.

revolvePoint[p_] := ParametricPlot3D[
   {p[[1]], 0, 0} + Cos[theta] {0, p[[2]], 0} + Sin[theta] {0, 0, p[[2]]},
   {theta, 0, Pi}, PlotStyle -> Directive[Opacity[0.8], Thin]];
revolveSegment[{s_, f_}] := Module[{p},
   p[t_] = (1 - t) s + t*f;
   ParametricPlot3D[{p[t][[1]], 0, 0} + Cos[theta] {0, p[t][[2]], 0} +
      Sin[theta] {0, 0, p[t][[2]]}, {t, 0, 1}, {theta, 0, Pi},
    PlotPoints -> {2, 24}, Mesh -> None, MaxRecursion -> 0]];

Note that $\theta$ ranges only from zero to $\pi$ due to the symmetry of the figure. I suppose this could be done more efficiently by only grabbing the top half and going from zero to $2\pi$. At any rate, we can now illustrate the revolved figure as follows:

Show[Join[revolveSegment /@ edges, revolvePoint /@ First /@ edges], 
  PlotRange -> All, Boxed -> False, Axes -> None]

enter image description here

Now, to compute the volume, I would recommend two approaches.

First, and more simply, we can generate a lower bound by simply computing the sum of the volumes generated by revolving the individual triangles around the $x$-axis. These can all be easily computed and I'm sure many folks here on this group can do so.

Secondly, I believe the volume can be expressed as the integral $$\pi\int_K \ y^2\ d\mu,$$ where the integral is over the whole Koch snowflake $K$ and $\mu$ is Lebesgue measure on $K$. Furthermore, this integral can be evaluated in closed form using Stricartz's technique of self-similar integration. I used this for a similar problem on math.se.

$\endgroup$
  • 2
    $\begingroup$ wow really nice and very useful paper: seasons greeting :) $\endgroup$ – ubpdqn Dec 24 '15 at 15:29
  • $\begingroup$ @ubpdqn Thanks - and same to you! $\endgroup$ – Mark McClure Dec 24 '15 at 15:29
16
$\begingroup$

In the spirit of the season:

I used a Lindenmayer (L-) system for the Koch snowflake. I extracted the points of the third generation (ks posted at the end), then interpolated and parametrized (after translation) and added some "decoration" to cover unsightly joins (that Mesh did not deal with):

xif = ListInterpolation[ks[[All, 1]], {0, 1}, InterpolationOrder -> 1];
yif = ListInterpolation[ks[[All, 2]], {0, 1}, InterpolationOrder -> 1];
RegionCentroid[Polygon[ks]]
ParametricPlot[{xif[t], yif[t]}, {t, 0, 1}, 
 GridLines -> {{13.5}, None}]
p1a = ParametricPlot3D[{{Cos[Pi/2], 0, Sin[Pi/2]}, {0, 1, 
      0}, {-Sin[Pi/2], 0, 
      Cos[Pi/2]}}.({xif[t], yif[t], 0} - {13.5, 0, 0}), {t, 0, 1}, 
   PlotPoints -> 25, Background -> Black, Boxed -> False, 
   Mesh -> None, Axes -> False, BoxRatios -> Automatic, 
   PlotStyle -> {Yellow, Thickness[0.02]}];
p1b = ParametricPlot3D[({xif[t], yif[t], 0} - {13.5, 0, 0}), {t, 0, 
    1}, Background -> Black, Boxed -> False, PlotPoints -> 25, 
   Mesh -> None, Axes -> False, BoxRatios -> Automatic, 
   PlotStyle -> {Yellow, Thickness[0.02]}];
p1c = ParametricPlot3D[{{Cos[Pi/4], 0, Sin[Pi/4]}, {0, 1, 
      0}, {-Sin[Pi/4], 0, 
      Cos[Pi/4]}}.({xif[t], yif[t], 0} - {13.5, 0, 0}), {t, 0, 1}, 
   PlotPoints -> 25, Background -> Black, Boxed -> False, 
   Mesh -> None, Axes -> False, BoxRatios -> Automatic, 
   PlotStyle -> {Red, Thickness[0.02]}];
p1d = ParametricPlot3D[{{Cos[3 Pi/4], 0, Sin[3 Pi/4]}, {0, 1, 
      0}, {-Sin[3 Pi/4], 0, 
      Cos[3 Pi/4]}}.({xif[t], yif[t], 0} - {13.5, 0, 0}), {t, 0, 1}, 
   PlotPoints -> 25, Background -> Black, Boxed -> False, 
   Mesh -> None, Axes -> False, BoxRatios -> Automatic, 
   PlotStyle -> {Red, Thickness[0.02]}];
p2 = ParametricPlot3D[{{Cos[u], 0, Sin[u]}, {0, 1, 0}, {-Sin[u], 0, 
      Cos[u]}}.({xif[t], yif[t], 0} - {13.5, 0, 0}), {t, 0, 1}, {u, 0,
     Pi}, Background -> Black, Boxed -> False, Mesh -> None, 
   Axes -> False, BoxRatios -> Automatic, PlotPoints -> 50, 
   PerformanceGoal -> "Quality", PlotStyle -> White];
Show[p2, p1a, p1b, p1c, p1d]

the snowflake

snowflake, revolved around the vertical axis

Peace and good will to all and hopes for a prosperous 2016...

The coordinates:

ks = {{0, 0}, {1., 0.}, {1.5, 0.8660254037844386}, {2., 0.}, {3., 0.},
      {3.5, 0.8660254037844386}, {3., 1.7320508075688772},
      {4., 1.7320508075688772}, {4.5, 2.598076211353316},
      {5., 1.7320508075688774}, {6., 1.7320508075688774},
      {5.5, 0.8660254037844387}, {6., 1.1102230246251565*^-16},
      {7., 1.1102230246251565*^-16}, {7.5, 0.8660254037844387},
      {8., 1.1102230246251565*^-16}, {9., 1.1102230246251565*^-16},
      {9.5, 0.8660254037844387}, {9., 1.7320508075688774},
      {10., 1.7320508075688774}, {10.5, 2.598076211353316},
      {10., 3.464101615137755}, {9., 3.464101615137755},
      {9.5, 4.330127018922194}, {9., 5.196152422706632},
      {10., 5.196152422706632}, {10.5, 6.062177826491071},
      {11., 5.196152422706633}, {12., 5.196152422706634},
      {12.5, 6.062177826491073}, {12., 6.928203230275511},
      {13., 6.928203230275512}, {13.5, 7.794228634059952},
      {14., 6.928203230275513}, {15., 6.928203230275514},
      {14.5, 6.062177826491075}, {15., 5.1961524227066365},
      {16., 5.196152422706637}, {16.5, 6.062177826491077},
      {17., 5.196152422706638}, {18., 5.196152422706639},
      {17.5, 4.3301270189222}, {18., 3.4641016151377615},
      {17., 3.4641016151377606}, {16.5, 2.5980762113533213},
      {17., 1.732050807568883}, {18., 1.7320508075688834},
      {17.5, 0.8660254037844444}, {18., 5.995204332975845*^-15},
      {19., 6.439293542825908*^-15}, {19.5, 0.8660254037844453},
      {20., 6.8833827526759706*^-15}, {21., 7.327471962526033*^-15},
      {21.5, 0.8660254037844461}, {21., 1.7320508075688847},
      {22., 1.7320508075688852}, {22.5, 2.598076211353324},
      {23., 1.7320508075688856}, {24., 1.732050807568886},
      {23.5, 0.866025403784447}, {24., 8.659739592076221*^-15},
      {25., 9.103828801926284*^-15}, {25.5, 0.8660254037844479},
      {26., 9.547918011776346*^-15}, {27., 9.992007221626409*^-15},
      {26.5, -0.866025403784429}, {27., -1.7320508075688674},
      {26., -1.7320508075688685}, {25.5, -2.5980762113533076},
      {26., -3.464101615137746}, {27., -3.4641016151377455},
      {26.5, -4.330127018922185}, {27., -5.196152422706623},
      {26., -5.196152422706624}, {25.5, -6.062177826491063},
      {25., -5.196152422706625}, {24., -5.196152422706626},
      {23.5, -6.062177826491065}, {24., -6.928203230275503},
      {23., -6.928203230275504}, {22.5, -7.794228634059944},
      {23., -8.660254037844382}, {24., -8.660254037844382},
      {23.5, -9.526279441628821}, {24., -10.39230484541326},
      {25., -10.39230484541326}, {25.5, -9.526279441628821},
      {26., -10.39230484541326}, {27., -10.39230484541326},
      {26.5, -11.2583302491977}, {27., -12.124355652982139},
      {26., -12.12435565298214}, {25.5, -12.99038105676658},
      {26., -13.856406460551018}, {27., -13.856406460551018},
      {26.5, -14.722431864335457}, {27., -15.588457268119896},
      {26., -15.588457268119898}, {25.5, -16.454482671904337},
      {25., -15.5884572681199}, {24., -15.588457268119901},
      {23.5, -16.45448267190434}, {24., -17.320508075688778},
      {23., -17.320508075688778}, {22.5, -18.186533479473216},
      {22., -17.320508075688778}, {21., -17.320508075688778},
      {21.5, -16.454482671904337}, {21., -15.5884572681199},
      {20., -15.588457268119901}, {19.5, -16.45448267190434},
      {19., -15.588457268119903}, {18., -15.588457268119905},
      {17.5, -16.454482671904344}, {18., -17.32050807568878},
      {17., -17.32050807568878}, {16.5, -18.18653347947322},
      {17., -19.052558883257657}, {18., -19.052558883257657},
      {17.5, -19.918584287042094}, {18., -20.78460969082653},
      {17., -20.78460969082653}, {16.5, -21.65063509461097},
      {15.999999999999998, -20.78460969082653}, {14.999999999999998, -20.78460969082653},
      {14.499999999999998, -21.65063509461097}, {14.999999999999998, -22.516660498395407},
      {13.999999999999998, -22.516660498395407}, {13.499999999999998, -23.382685902179844},
      {12.999999999999996, -22.516660498395407}, {11.999999999999996, -22.516660498395407},
      {12.499999999999995, -21.650635094610966}, {11.999999999999993, -20.784609690826528},
      {10.999999999999993, -20.784609690826528}, {10.499999999999993, -21.650635094610966},
      {9.999999999999991, -20.784609690826528}, {8.999999999999991, -20.784609690826528},
      {9.49999999999999, -19.918584287042087}, {8.999999999999988, -19.05255888325765},
      {9.999999999999988, -19.052558883257646}, {10.499999999999986, -18.186533479473205},
      {9.999999999999984, -17.320508075688767}, {8.999999999999984, -17.320508075688767},
      {9.499999999999982, -16.454482671904326}, {8.99999999999998, -15.588457268119889},
      {7.9999999999999805, -15.58845726811989}, {7.499999999999981, -16.45448267190433},
      {6.9999999999999805, -15.588457268119893}, {5.9999999999999805, -15.588457268119894},
      {5.499999999999981, -16.454482671904334}, {5.999999999999982, -17.32050807568877},
      {4.999999999999982, -17.32050807568877}, {4.499999999999983, -18.18653347947321},
      {3.9999999999999822, -17.32050807568877}, {2.9999999999999822, -17.32050807568877},
      {3.499999999999981, -16.45448267190433}, {2.9999999999999796, -15.588457268119893},
      {1.9999999999999796, -15.588457268119894}, {1.4999999999999802, -16.454482671904334},
      {0.9999999999999791, -15.588457268119896}, {-2.0872192862952943*^-14, -15.588457268119898},
      {0.4999999999999777, -14.722431864335459}, {-2.3425705819590803*^-14, -13.856406460551021}, 
      {0.9999999999999766, -13.85640646055102},
      {1.4999999999999751, -12.99038105676658}, {0.999999999999974, -12.124355652982143},
      {-2.5979218776228663*^-14, -12.124355652982144}, {0.4999999999999726, -11.258330249197705},
      {-2.853273173286652*^-14, -10.392304845413268}, {0.9999999999999715, -10.392304845413266},
      {1.49999999999997, -9.526279441628827}, {1.999999999999972, -10.392304845413264},
      {2.999999999999972, -10.392304845413262}, {3.4999999999999707, -9.526279441628823},
      {2.99999999999997, -8.660254037844386}, {3.99999999999997, -8.660254037844384},
      {4.499999999999968, -7.7942286340599445}, {3.999999999999967, -6.928203230275507},
      {2.999999999999967, -6.928203230275508}, {3.499999999999966, -6.062177826491069},
      {2.9999999999999645, -5.19615242270663}, {1.9999999999999645, -5.196152422706631},
      {1.4999999999999651, -6.06217782649107}, {0.999999999999964, -5.196152422706632},
      {-3.597122599785507*^-14, -5.196152422706633}, {0.4999999999999626, -4.330127018922194},
      {-3.852473895449293*^-14, -3.4641016151377557}, {0.9999999999999615, -3.4641016151377535},
      {1.49999999999996, -2.5980762113533142}, {0.9999999999999589, -1.7320508075688763},
      {-4.107825191113079*^-14, -1.7320508075688774}, {0.4999999999999575, -0.8660254037844379},
      {-4.363176486776865*^-14, 0.}};
$\endgroup$
  • $\begingroup$ Fractal Christmas tree ornaments on the 24th: A mandatory +1! $\endgroup$ – Yves Klett Dec 24 '15 at 7:30
  • $\begingroup$ @YvesKlett thank you...seasons greeting to you too :) $\endgroup$ – ubpdqn Dec 24 '15 at 7:44
  • $\begingroup$ @ubpdqn An interesting fact about this shape is that Surface Area is infinity and Volume is finite :) $\endgroup$ – vito Dec 24 '15 at 9:05
  • $\begingroup$ @vito in the limit...this is just 3 generations...seasons greetings vito :) $\endgroup$ – ubpdqn Dec 24 '15 at 9:07
  • $\begingroup$ @ubpdqn Another question is " How to find the volume of this shape"? :) I try to use "Pappus's Centroid Theorem" but this is not easy to find the geometric centroid of fractal $\endgroup$ – vito Dec 24 '15 at 9:12
10
$\begingroup$

I try to use RevolutionPlot3D[f, {t, t1}], but I think there is no $f$ for Koch Snowflake.

Here's one:

f[t_, θ_, 0] := t AngleVector[θ]
f[t_, θ_, n_] := Piecewise[{
   {1/3 f[4 t, θ, n - 1], t <= 1/4},
   {1/3 (AngleVector[θ] + f[4 t - 1, θ + π/3, n - 1]), 1/4 <= t <= 2/4},
   {1/3 (AngleVector[θ] + AngleVector[θ + π/3] + f[4 t - 2, θ - π/3, n - 1]), 2/4 <= t <= 3/4},
   {1/3 (2 AngleVector[θ] + f[4 t - 3, θ, n - 1]), 3/4 <= t}}]

ParametricPlot[f[t, 0, 4], {t, 0, 1}]

enter image description here

Assembling the entire snowflake and applying RevolutionPlot3D is left as an exercise for the reader.


Note that the parametrization expands to piecewise linear segments over the intervals $\left[0,\cfrac1{2^n}\right], \left[\cfrac1{2^n},\cfrac2{2^n}\right], \ldots$, though one has to be a little careful to avoid threading the addition in AngleVector[...] + f[...]. For example:

f2[t_, θ_, 0] := t AngleVector[θ]
f2[t_, θ_, n_] := Piecewise[{
   {1/3 f2[4 t, θ, n - 1], t <= 1/4},
   {1/3 (AngleVector[θ] ~plus~ f2[4 t - 1, θ + π/3, n - 1]), 1/4 <= t <= 2/4},
   {1/3 (AngleVector[θ] ~plus~ AngleVector[θ + π/3] ~plus~ f2[4 t - 2, θ - π/3, n - 1]), 2/4 <= t <= 3/4},
   {1/3 (2 AngleVector[θ] ~plus~ f2[4 t - 3, θ, n - 1]), 3/4 <= t}}]

(PiecewiseExpand[f2[t, 0, 2]] /. plus -> Plus) // Simplify

$$\begin{cases} \left\{\frac{16 t}{9},0\right\} & 16 t\leq 1 \\ \left\{\frac{32 t}{9}-2,0\right\} & \frac{3}{4}<t\leq \frac{13}{16} \\ \left\{\frac{1}{9} (8 t+1),\frac{2 (4 t-1)}{3 \sqrt{3}}\right\} & \frac{1}{4}<t\leq \frac{5}{16} \\ \left\{\frac{4}{9} (8 t-1),0\right\} & \frac{3}{16}<t\leq \frac{1}{4} \\ \left\{\frac{8 t}{9}+\frac{1}{18},\frac{16 t-1}{6 \sqrt{3}}\right\} & \frac{1}{16}<t\leq \frac{1}{8} \\ \left\{\frac{2}{3}-\frac{8 t}{9},\frac{2 (4 t-1)}{3 \sqrt{3}}\right\} & \frac{5}{16}<t\leq \frac{3}{8} \\ \left\{\frac{1}{9} (16 t-3),\frac{2 (8 t-3)}{3 \sqrt{3}}\right\} & \frac{7}{16}<t\leq \frac{1}{2} \\ \left\{\frac{2}{9} (32 t-25),0\right\} & 16 t>15 \\ \left\{\frac{1}{9} (16 t-5),\frac{16 t-13}{3 \sqrt{3}}\right\} & \frac{13}{16}<t\leq \frac{7}{8} \\ \left\{\frac{1}{9} (16 t-3),\frac{1}{3 \sqrt{3}}\right\} & \frac{3}{8}<t\leq \frac{7}{16} \\ \left\{\frac{1}{9} (16 t-5),\frac{15-16 t}{3 \sqrt{3}}\right\} & \frac{7}{8}<t\leq \frac{15}{16} \\ \left\{\frac{8 t}{9}+\frac{1}{18},\frac{11-16 t}{6 \sqrt{3}}\right\} & \frac{1}{2}<t\leq \frac{9}{16} \\ \left\{\frac{8 t}{9}+\frac{1}{18},\frac{3-16 t}{6 \sqrt{3}}\right\} & \frac{1}{8}<t\leq \frac{3}{16} \\ \left\{\frac{1}{18} (32 t-11),\frac{23-32 t}{6 \sqrt{3}}\right\} & \frac{11}{16}<t\leq \frac{3}{4} \\ \left\{\frac{4}{9} (4 t-1),\frac{1}{3 \sqrt{3}}\right\} & \frac{9}{16}<t\leq \frac{5}{8} \\ \left\{\frac{1}{9} (11-8 t),\frac{6-8 t}{3 \sqrt{3}}\right\} & \text{True} \end{cases}$$

Now if only the cases turned out in the right order...

$\endgroup$
  • $\begingroup$ you directly and the question with a parametrization. +1 Seasons greetings :) $\endgroup$ – ubpdqn Dec 24 '15 at 5:52
4
$\begingroup$

I will use the strategy previously used in this answer; that is, represent a surface of revolution as a NURBS surface.

First, I generate half of the snowflake to be rotated later, using repeated subdivision:

kochinsert[pts_?MatrixQ] :=
           Insert[#, Composition[TranslationTransform[#[[2]] - #[[1]]], 
                                 RotationTransform[-π/3, #[[1]]]][#[[2]]], 3] &[
                     Transpose[{1 - #, #}] &[Subdivide[3]].pts]

koch[pts_?MatrixQ] := 
     Apply[Join, Prepend[Rest /@ Rest[#], First[#]]] &[kochinsert /@
     Partition[pts, 2, 1]]

halfkoch = {{0, 1}, {-1/(2 Sqrt[3]), 1/2}, {-Sqrt[3]/2, 1/2}, {-Sqrt[3]/2, 1/2},
            {-1/Sqrt[3], 0}, {-Sqrt[3]/2, -1/2}, {-1/(2 Sqrt[3]), -1/2}, {0, -1}};

snowflake = Nest[koch, N[halfkoch, 20], 4];

(At this point, you can use Graphics[Line[snowflake]] to see the snowflake's outline.)

From this, generate the surface of revolution:

circPoints = {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}};
circKnots = {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1};
circWts = {1, 1/2, 1/2, 1, 1/2, 1/2, 1};

Graphics3D[BSplineSurface[Map[Function[pt, Append[#1 pt, #2]], circPoints] & @@@
                          snowflake, 
                          SplineClosed -> True, SplineDegree -> {1, 2}, 
                          SplineKnots -> {Automatic, circKnots}, 
                          SplineWeights -> ConstantArray[circWts, Length[snowflake]]], 
           Boxed -> False]

look at 'em ribs, son!

$\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.