2
$\begingroup$

Can I get a link to a notebook that explores this fractal structure?

enter image description here

I am specifically asking for a url to a Mathematica notebook that generates and / or visualizes this type of fractal.

If that is not available, then what would be the Mathematica command(s) to generate this visualization? It doesn't have to rotate or be animated. This is just someone's animation that they made in PHP.

Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ Please be more specific in order to increase your chances of useful responses. $\endgroup$
    – bbgodfrey
    Commented Mar 13, 2015 at 1:37
  • 2
    $\begingroup$ For the visualization only: p=Select[{-1,0,1}~Tuples~3,#.#<2&];Graphics3D[{Nest[#~Translate~p~Scale~(1/3)&,Cuboid[],3]}] $\endgroup$
    – Simon Woods
    Commented Mar 13, 2015 at 18:09
  • $\begingroup$ @SimonWoods, looks like it's opened back up if you want to answer. Thanks! $\endgroup$
    – toddmo
    Commented Mar 14, 2015 at 4:05

2 Answers 2

Reset to default
7
$\begingroup$

To create the visualisation you can use Translate and Scale to iteratively create the object from a starting cube. Here p is a list of translation vectors and f is a function which applies the transformation. Nest is used to repeatedly apply f to an initial Cuboid[].

p = {{-1, 0, 0}, {0, -1, 0}, {0, 0, -1}, {0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {1, 0, 0}};

f[x_] := Scale[Translate[x, p], 1/3]

Graphics3D[Nest[f, Cuboid[], 3], Boxed -> False]

enter image description here

An alternative approach, which may be more useful for studying the structure, is to create it as a 3 dimensional array of ones and zeros. Here's one way to do that:

kernel = Normal @ SparseArray[(p + 2) -> 1];

g[x_] := ArrayFlatten[Map[kernel # &, x, {3}], 3]

Image3D[Nest[g, kernel, 2]]

enter image description here

Improve this answer
$\endgroup$
2
$\begingroup$

This is a slight rewrite of Simon's solution that I picked up from Brett:

t1 = Composition[ScalingTransform[{1/3, 1/3, 1/3}], TranslationTransform[#]] & /@
     {{-1, 0, 0}, {0, -1, 0}, {0, 0, -1}, {0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {1, 0, 0}};

tn = {#["AffineMatrix"], #["AffineVector"]} & /@
     Nest[Flatten[Outer[Composition, t1, #]] &, t1, 4]; (* fourth iterate *)

Graphics3D[{EdgeForm[], GeometricTransformation[Cuboid[], tn]}, Boxed -> False]

Vicsek fractal

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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