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

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

There's also a stochastic version
ShowIFSStochastic[IFS, 50000, Colors -> True, ImageSize -> 600]

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