3d von Koch

[Roger Bagula]

I figured out how to use the Menger sponge program to give
Lauwerier's 3d von Koch.

Pictures:
http://profile.imeem.com/GUmj0c/photo/rhidP5F98h/
http://profile.imeem.com/GUmj0c/photo/oJx8SaGGpa/

Clear[pieces, menger]
(*from Hans Lauwerier, "Fractals, Endlessly Repeating Geometrical Figures",
Princeton Science Library, Page 129*)
pieces =
Join[{{0, 2, 2}, {4, 2, 2}, {2, 0, 2}, {2, 4, 2}, {2, 2, 0}, {2, 2, 4}},
Flatten[Table[{i, j, k}, {i, 1, 3}, {j, 1, 3}, {k, 1, 3}], 2]];
N[Log[Length[pieces]]/Log[5]]
2.1725022968909635`
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/5), sideLen/5, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[], Cuboid[cornerPt, cornerPt + sideLen*{1, 1, 1}]};
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 1]]], Boxed -> False]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 2]]], Boxed -> False]
gr = Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]
Show[gr, ViewPoint -> {2.367, 2.305, 0.730}]

[Roger Bagula]

(* 3d von Koch IFS 3d Fractal*)
(* by R. L. Bagula 07 Sept. 2007 ©*)
(*from Hans Lauwerier, "Fractals, Endlessly Repeating Geometrical Figures",
Princeton Science Library, Page 129*)
Clear[f, dlst, pt, cr, ptlst]
in = Join[{{0, 2, 2}, {4, 2, 2}, {2, 0, 2}, {2, 4, 2}, {2, 2, 0}, {2, 2,
4}},
Flatten[Table[{i, j, k}, {i, 1, 3}, {j, 1, 3}, {k, 1, 3}], 2]];
Length[in];
dim_app = N[Log[Length[in]]/Log[5]]
2.1725022968909635`
dlst = Table[ Random[Integer, {1, Length[in]}], {n, 25000}];

f[j_, {x_, y_, z_}] := {x, y, z}/5 + in[[j]];

pt = {0.5, 0.5, 0.5};

cr[n_] := Flatten[Table[If[
i == j == k == 1, {}, RGBColor[i, j, k]], {i, 0, 1,
0.5}, {j, 0, 1, 0.5}, {k, 0, 1, 0.5}]][[1 + Mod[n, 26]]];
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
g = Show[Graphics3D[Join[{PointSize[.001]}, ptlst]], AspectRatio ->
Automatic, PlotRange -> All, Boxed -> False]
Show[g, ViewPoint -> {-0.178, -0.172, 3.375}]
Show[g, ViewPoint -> {2.649, -2.104, 0.059}]

[Roger Bagula]

This method is sort of a clunky way to make
a triangular 3d von Koch using Cuboids.
It doesn't start to look triangular except by level 3.
What I did was take a triangular carpet tetrahedron ( 10 cubes , ratio 3)
and added a central cube and face cubes
to get this at 15 cubes and a ratio of 4.
If I could get the Mathematica Tetrahedron[] graphic primitive to work like
a Cuboid[] , I would have used it instead.
Essentually what I'm doing if a three relative size tetrahedron with a
one size
tetrahedron on each face ( sort of a 3d Jewish Star) using cubes
instead of tetrahedrons.

Picture:
http://profile.imeem.com/GUmj0c/photo/_BKRMfb9tf/

Mathematica code:
Clear[pieces, menger]
(* 3d tetrahedron/ cuboid triangular von Koch*)
(* Roger Bagula 09 sept 2007©*)
pieces =
{{1, 0, 1}, {-1, 0, 1}, {0, -1, -1}, {0, 1, -1}, {0, 0, 1}, {0, 0, -1},
{0, \
0, 0}, {0, 1.5, 0}, {0, -1.5, 0}, {
1.5, 0, 0}, {-1.5, 0,
0}, {1/2, 1/2, 0}, {1/2, -1/2, 0}, {-1/2, 1/2, 0}, {-1/2, -1/2, 0}};
N[Log[Length[pieces]]/Log[4]]
1.9534452978042591`
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/4), sideLen/4, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[], Cuboid[ cornerPt , cornerPt + sideLen*{1, 1, 1}]};
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 1]]], Boxed -> False]
gr = Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]
Show[gr, ViewPoint -> {-0.002, 1.297, 3.125}]

[eNZedBlue]

Post by Roger Bagula
I figured out how to use the Menger sponge program to give
Lauwerier's 3d von Koch.
Pictures:http://profile.imeem.com/GUmj0c/photo/rhidP5F98h/http://profile.imeem.com/GUmj0c/photo/oJx8SaGGpa/

I've rendered some 3D Koch fractals out of cubes, octahedrons,
tetrahedrons (stella octangula) and spheres here (scroll down to
bottom):

http://www.enzedblue.com/KOchCROP/KochCropCircles.html

and here:

Loading Image...

Unlike the regular 3D Koch these have a 2D Koch fractal silhoette when
viewed from a 45 degree angle (pitch and yaw). The sphere-based one is
the "Sphereflake".

Regards,
Chris Hayton

[Roger Bagula]

Post by eNZedBlue
I've rendered some 3D Koch fractals out of cubes, octahedrons,
tetrahedrons (stella octangula) and spheres here (scroll down to
http://www.enzedblue.com/KOchCROP/KochCropCircles.html
http://www.enzedblue.com/Images/KochCrystal.jpg
Unlike the regular 3D Koch these have a 2D Koch fractal silhoette when
viewed from a 45 degree angle (pitch and yaw). The sphere-based one is
the "Sphereflake".
Regards,
Chris Hayton

Your cube version is a variation of a von Koch four
with vertex cubes instead of face cubes as Lauwerier uses.
Your octahedron appears to be a face version.

As John Bailey points out there is more than
one way to "skin" von Koch.
Roger Bagula

[Roger Bagula]

Post by eNZedBlue
Unlike the regular 3D Koch these have a 2D Koch fractal silhoette when
viewed from a 45 degree angle (pitch and yaw). The sphere-based one is
the "Sphereflake".
Regards,
Chris Hayton

Chris Hayton
I did some work on this model.
It isn't strickly a classical von Koch but something new.
The corners overlap.
And the ratio is 4 instead of 5 as in the Lawerier version.
It may not be the best version of this fractal,
but it is connected. Your faces are too plain in your versions:
this version has both bumps and voids.
Moran dimension:
2.564641508472483
Menger cube version takes forever in Mathenmatica
at level 3.
Pictures:
http://profile.imeem.com/GUmj0c/photo/EjvNo7XVrN/
http://profile.imeem.com/GUmj0c/photo/KVkOBoyKGy/
Mathematica IFS:
(* 3d von Koch corner cube IFS 3d Fractal*)
(* by R. L. Bagula 07 Sept. 2007 ©*)
(*Chris Hayton : web cormer 3d von Koch cube*)
Clear[f, dlst, pt, cr, ptlst]
in = Join[Flatten[Table[{i,
j, k}*1.5, {i, -1, 1, 2}, {j, -1, 1, 2}, {k, -1, 1, 2}], 2], \
Flatten[Table[{i, j, k}, {i, -1, 1}, {j, -1, 1}, {k, -1, 1}], 2]]
Length[in];
dim_app = N[Log[Length[in]]/Log[4]]
2.564641508472483`
dlst = Table[ Random[Integer, {1, Length[in]}], {n, 25000}];

f[j_, {x_, y_, z_}] := {x, y, z}/4 + in[[j]];

pt = {0.5, 0.5, 0.5};

cr[n_] := Flatten[Table[If[i == j == k == 1, {}, RGBColor[i, j, k]], {
i, 0, 1, 0.5}, {j, 0, 1, 0.5}, {k, 0, 1, 0.5}]][[1 + Mod[n, 26]]];
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
g = Show[Graphics3D[
Join[{PointSize[.001]}, ptlst]], AspectRatio ->
Automatic, PlotRange -> All, Boxed -> False]
Show[g, ViewPoint -> {-0.178, -0.172, 3.375}]
Show[g, ViewPoint -> {2.649, -2.104, 0.059}]

Mathematica Menger cube version:
Clear[pieces, menger]
pieces =
Join[Flatten[Table[{i, j, k}*1.5, {i, -1,
1, 2}, {j, -1,
1, 2}, {k, -1, 1, 2}], 2], Flatten[Table[{i, j, k}, {i, -1, 1}, {j, -1,
1}, {k, -1, 1}], 2]]
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/4), sideLen/4, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[], Cuboid[ cornerPt , cornerPt + sideLen*{1, 1, 1}]};
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 1]]], Boxed -> False]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 2]]], Boxed -> False]
gr = Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]
Show[gr, ViewPoint -> {-0.002, 1.297, 3.125}]

Roger Bagula