6
$\begingroup$

I know how to construct the Koch snowflake:

f[{a:{x1_,y1_},b:{x2_,y2_}}] :=
  Partition[{a,(2a+b)/3,{3(x1+x2)+√3(y1-y2),√3(x2-x1)+3 (y1+y2)}/6,(a+2b)/3,b},2,1];
pts=Join@@Nest[Join@@f/@#&,.5{{{0,0},{2,0}},{{2,0},{1,-√3}},{{1,-√3},{0,0}}},5];
Graphics[Polygon @ pts]

and draw a hue disk (How do I draw a Circular Graph colored like this in Mathematica?), but how do I draw a Koch snowflake with hue-based coloring like this? Vector diagrams are better than images.

color wheel on Koch snowflake

$\endgroup$
10
$\begingroup$

With a hue disk as you suggested (but slightly tweaked to get the colours in the right spot):

hueDisk = With[{sectors = 360}, angle = 2 Pi/sectors;
  Table[{Hue[1 - i/sectors], EdgeForm[{Thick, Hue[1 - i/sectors]}], 
    Disk[{0, 0}, 0.6, {\[Pi]/2 + i angle, \[Pi]/2 + (i + 1) angle}]}, {i, 0, sectors - 1}]];

Then we can use the FilledCurve technique to draw the snowflake over the top:

Graphics[{hueDisk,
  FaceForm[White], EdgeForm[Black],
  FilledCurve[{
    {Line[{ImageScaled[{-2, -2}], ImageScaled[{2, -2}], 
       ImageScaled[{2, 2}], ImageScaled[{-2, 2}]}]},
    {Line@With[{m = Mean@pts}, # - m & /@ pts]}}]}]

hueflake

$\endgroup$
7
$\begingroup$

One way is to use your code for the snowflake, and turn it into an image. Then use the code for the colored circle and turn it into an image. Then multiply:

f[{a : {x1_, y1_}, b : {x2_, y2_}}] := 
  Partition[{a, (2 a + b)/3, {3 (x1 + x2) + \[Sqrt]3 (y1 - y2), \[Sqrt]3 (x2 - x1) + 
       3 (y1 + y2)}/6, (a + 2 b)/3, b}, 2, 1];
pts = Join @@ Nest[Join @@ f /@ # &, .5 
     {{{0, 0}, {2, 0}}, {{2, 0}, {1, -\[Sqrt]3}}, {{1, -\[Sqrt]3}, {0, 0}}}, 5];
flake = ColorNegate[Image[Graphics[Polygon@pts], ImageSize -> 400]];
circle = Image[With[{sectors = 360}, angle = 2 Pi/sectors;
    Graphics[Table[{Hue[i/sectors], EdgeForm[{Thick, Hue[i/sectors]}], 
       Disk[{0, 0}, 1, {i angle, (i + 1) angle}]}, {i, 0,  sectors - 1}]]], ImageSize -> 400];
ColorNegate[ImageMultiply[flake, circle]]

enter image description here

$\endgroup$
2
$\begingroup$
Clear["`*"]
f[{a_,b_}]:={3a,2a+b,3/2(a+b)+√3/2(b-a).RotationMatrix[-Pi/2],a+2b,3b}/3;
pts=Nest[Join@@f/@Partition[#,2,1]&,.5{{0,0},{2,0},{1,-√3},{0,0}},3];
img=Colorize[Image@Rescale@Table[ArcTan[x,y+1.*^-6],{x,-200,200},{y,-200,200}],ColorFunction->Hue];
ImageAdd[img,Graphics[Polygon@pts]]

pts = # - Mean@pts & /@ pts;
Graphics[{Texture@img,Polygon[pts,VertexTextureCoordinates->Rescale@pts]}]

enter image description here

$\endgroup$
2
$\begingroup$

Using the Koch snowflake generator from here, and the current ability of Mathematica to plot over polygons, here is one more possibility:

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]]

ks = Polygon[Nest[koch, Append[#, First[#]] & @ N[CirclePoints[3]], 4]];
DensityPlot[ArcTan[-y, -x], {x, y} ∈ ks, BoundaryStyle -> Black, ColorFunction -> Hue,
            Exclusions -> None, Frame -> False, PlotPoints -> 95]

color wheel on Koch snowflake

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