7
$\begingroup$

I'm new not only to this forum, but to Mathematica in general, evidently. I'm running into an issue, and my best attempts at Googling solutions (and trying the search box for this forum) came up with nothing.

For those not immediately familiar, an iterated function system is a family $\Phi = \{ \phi_{1}, \ldots, \phi_{N} \}$ of contractive maps $ \phi_{j} : \mathbb{R}^{d} \to \mathbb{R}^{d}$, where $d \in \mathbb{N}$. It's well-known that if we define a map $\Phi : 2^{\mathbb{R}^{d}} \to 2^{\mathbb{R}^{d}}$ by $\Phi(S) = \cup_{j = 1}^{N} \phi_{j}(S)$, then if we endow the set $\mathcal{K}(\mathbb{R}^{d})$ of all compact subsets of $\mathbb{R}^{d}$ with the Hausdorff metric, then the map $\Phi$ is a contraction on the complete metric space $\mathcal{K}(\mathbb{R}^{d})$, and thus we can appeal to Banach's fixed point theorem to show that there must exist a compact set $K = K(\Phi) \subseteq \mathcal{K}(\mathbb{R}^{d})$ for which $\Phi(K) = K$, and moreover that for any compact set $K' \subseteq \mathcal{K}(\mathbb{R}^{d})$, we have that $\lim_{k \to \infty} \Phi^{k} (K') = K$ (in ths sense of Hausdorff metric). We call $K$ the attractor of $\Phi$.

Now, the neat things here are twofold. One is that we can get a reasonable visual approximation of $K$ by just looking at $\Phi^{k}(K')$ for large $k$. Moreover, many notable fractals can be described by an IFS, e.g. the Cantor set is the attractor of the IFS $\Phi = \{ x \mapsto \frac{x}{3}, x \mapsto \frac{x + 2}{3} \}$.

What I'm looking for is a way to look at images of the iterates $\Phi^{k}(K)$ for a compact set $K$ (although I'd be satisfied with a finite set). I'm sorry, but I really have no earthly idea where to start with this. I know how to define the functions of the IFS itself, but I'm having trouble actually creating plots of the images, even when I'm just trying to look at a set like $\{ \phi_{1}(\phi_{2}(0)), \phi_{2}(\phi_{1}(0)) \}$, particularly when $d = 1, 2, 3$.

$\endgroup$
  • 1
    $\begingroup$ Just to be sure, this is a question about how to program the software (Mathematica) to do this? (See mathematica.stackexchange.com/help/on-topic.) Your statement is very general, of indefinite dimension $d$. Perhaps you can boil it down to a specific example to be computed (specific set of maps, of a specific dimension, etc)? $\endgroup$ – Michael E2 Jun 21 '15 at 5:25
  • $\begingroup$ Sorry. I was sloppy, but I think I fixed some of the inaccuracies. A typical example is that the Cantor set $C \subseteq [0, 1] \subseteq \mathbb{R}^{1}$ can be expressed as the attractor of the IFS $\Phi = \{ x \mapsto \frac{x}{3}, x \mapsto \frac{x + 2}{3} \}$. I might be interested in looking at, say, $\Phi^{k}( \{ 0, 1 \} )$ for large $k$, $\endgroup$ – AJY Jun 21 '15 at 5:27
  • $\begingroup$ What would be the proper tags? $\endgroup$ – AJY Jun 21 '15 at 6:30
  • 1
    $\begingroup$ There are several examples at the wolfram demonstration center such as demonstrations.wolfram.com/TheCantorSequenceWithBits and demonstrations.wolfram.com/FernFractals Search for "fractal". $\endgroup$ – bill s Jun 21 '15 at 8:22
  • $\begingroup$ Two suggestions: 1) Google on "Barnsley IFS Mathematica"; 2) Read this question $\endgroup$ – m_goldberg Jun 21 '15 at 10:16
10
$\begingroup$

I've written a package that allows you to easily generate images of self-similar sets in the plane. Here is a zip file containing that package, as well as a related package for digraph self-similar sets.

Here's an example of its use that seems related to your needs. We first load the package, after placing it in our $Path, as described in the installation instructions

Needs["FractalGeometry`IteratedFunctionSystems`"]

Next, we define an IFS as a list of {A,b} pairs, where A is a $2\times2$ matrix and $b$ is a shift vector.

IFS = {
  {{{9, 12}, {12, -9}}, {0, 0}},
  {{{9, -12}, {-12, -9}}, {16, 12}},
  {{{-7, 0}, {0, 7}}, {16, 12}}
}/25;

This particular IFS happens to map the triangle with the following vertices into itself.

vertices = {{0, 0}, {1, 0}, {1/2, 2/3}};

In the following code, we use a graphics primitive, like Polygon[vertices] to specify an Initiator; the IFS acts on the picture described by that primitive.

GraphicsGrid[Partition[Table[
  ShowIFS[IFS, k, Colors -> True, ImageSize -> 400,
  Initiator -> {EdgeForm[Black], Polygon[vertices]}],
 {k, 1, 4}], 2]]

enter image description here

Note that the IFS does not map the triangle onto itself in typical Sierpinski-like fashion. In particular, the images are flipped and the scaling factors are not all equal. When the scaling factors are unequal like this, it is sometimes useful to iterate until the pieces are small, rather than some pre-specified number of times throughout. To accomplish this, the second argument to ShowIFS can be a real number between zero and one to indicate how small we want the pieces to be.

ShowIFS[IFS, 0.01, Colors -> True, ImageSize -> 600,
  Initiator -> Polygon[vertices]]

enter image description here

There's also a stochastic version

ShowIFSStochastic[IFS, 50000, Colors -> True, ImageSize -> 600]

enter image description here

And here is the dimension of the set:

FindIFSDimension[IFS]
(* Out: 1.62234 *)

For those who might have difficulties obtaining the package, here is the code defining ShowIFS:

Options[ShowIFS] = Union[{AspectRatio -> Automatic,
  Initiator -> Point[{0,0}], Colors -> False, 
  PlotStyle -> {}}, Options[Graphics],
  SameTest -> (First[#1]===First[#2]&)];

ShowIFS[IFS_, depth_Integer?(# >= 0 &), opts___] := Module[
   {initiator, plotStyle, colors, toFunc, funcs, F,
    attractor, at, x},
   initiator = Initiator /. {opts} /. Options[ShowIFS];
   plotStyle = PlotStyle /. {opts} /. Options[ShowIFS];
   colors = Colors /. {opts} /. Options[ShowIFS];

   Which[colors === Automatic || colors === True,
    colors = 
     ColorData["Rainbow"] /@ 
      Range[0., 1 - 1./Length[IFS], 1./Length[IFS]],
    Head[colors] === String,
    colors = 
     ColorData[colors] /@ 
      Range[0., 1 - 1./Length[IFS], 1./Length[IFS]],
    colors =!= None && colors =!= False && Head[colors] =!= List,
    colors = 
     colors /@ Range[0., 1 - 1./Length[IFS], 1./Length[IFS]]];

   toFunc[{A_, b_}] := Module[{cfOut, fOut},
     cfOut = Compile[{{v, _Real, 1}}, A.v + b];
     fOut[{x_?NumericQ, y_?NumericQ}] := cfOut[{x, y}];
     fOut[x_List] := fOut /@ x;
     fOut[Point[pts_]] := Point[fOut[pts]];
     fOut[Line[x_]] := Line[fOut[x]];
     fOut[Arrow[x_]] := Arrow[fOut[x]];
     fOut[Polygon[x_, pOpts___]] := Polygon[fOut[x], pOpts];
     fOut[x_] := x;
     fOut];

   funcs = toFunc /@ IFS;
   F[Point[pt : {_?NumericQ, _?NumericQ}]] := 
    Point[Table[f[pt], {f, funcs}]];
   F[Point[pts : {{_?NumericQ, _?NumericQ} ..}]] :=
    Point[Flatten[Table[f /@ pts, {f, funcs}], 1]];
   F[Line[pts : {{_?NumericQ, _?NumericQ} ..}]] :=
    Line[Table[f /@ pts, {f, funcs}]];
   F[Line[pts : {{{_?NumericQ, _?NumericQ} ..} ..}]] :=
    Line[Flatten[Table[Map[f, pts, {2}], {f, funcs}], 1]];
   F[Arrow[pts : {{_?NumericQ, _?NumericQ} ..}, s___]] :=
    Table[Arrow[f /@ pts, s], {f, funcs}];
   F[Polygon[pts : {{_?NumericQ, _?NumericQ} ..}]] :=
    Polygon[Table[f /@ pts, {f, funcs}]];
   F[Polygon[pts : {{{_?NumericQ, _?NumericQ} ..} ..}]] :=
    Polygon[Flatten[Table[Map[f, pts, {2}], {f, funcs}], 1]];
   F[Polygon[pts : {{_?NumericQ, _?NumericQ} ..}, 
      VertexColors -> vc_]] :=
    Polygon[Table[f /@ pts, {f, funcs}], 
     VertexColors -> Table[vc, {Length[funcs]}]];
   F[Polygon[pts : {{{_?NumericQ, _?NumericQ} ..} ..}, 
      VertexColors -> vc_]] :=
    Polygon[Flatten[Table[Map[f, pts, {2}], {f, funcs}], 1],
     VertexColors -> Flatten[Table[vc, {Length[funcs]}], 1]];
   F[ll_List] := F /@ ll;
   F[x_] := x;
   If[colors =!= False && colors =!= None,
    attractor = Nest[F, initiator, depth - 1];
    attractor = at /@ Table[f[attractor], {f, funcs}];
    attractor = Inner[List, colors, attractor, List] /. 
      at[x__] -> x,
    attractor = Nest[F, initiator, depth]];
   Graphics[attractor,
    FilterRules[{opts}, Options[Graphics]],
    FilterRules[Options[ShowIFS], Options[Graphics]]]
];
$\endgroup$
  • $\begingroup$ Mr. McClure, I am having surprising trouble getting Mathematica to accept your packages. Even when I go through the "installation" bit from the "File" menu, when I try to implement the "Needs" command, it gives me error messages about being unable to find what it requires. $\endgroup$ – AJY Jun 22 '15 at 4:18
  • $\begingroup$ Did you execute the PrependTo command in the Quick start section before the Needs command? If so, what OS and version of Mathematica are you running? $\endgroup$ – Mark McClure Jun 22 '15 at 7:52
  • $\begingroup$ @AJY Were you able to get my packages to work? I'd certainly be happy to help. $\endgroup$ – Mark McClure Jul 1 '15 at 14:13
  • $\begingroup$ I was not able to because I'm still having trouble figuring out how to get these packages working. I'm running 9 on a Windows 7 machine. $\endgroup$ – AJY Jul 1 '15 at 15:32
  • $\begingroup$ @AJY I've added the code defining the depth level version of ShowIFS to the response. It works fine in V9 on my mac. The package contains some other features as well. I don't know why you're having problems with it on your machine. I assume you unzipped the file, opened up the Installation.nb file and executed the commands in order - including the PrependTo command? $\endgroup$ – Mark McClure Jul 1 '15 at 16:11

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.