IFS

[fregimus]

Не спалось, построил — чтобы уснуть. Не помогло, зато красиво. Тыцайте до полного размера 600×1000 (40 КБ). Хорошо известная формула, 600 тысяч итераций.



Исходный код, Mathematica 6.0, сырой и неоптимальный. Скорость примерно 10000 итер/сек на P4 2.8 MHz. Уменьшите размер пиксела до 0.001 и увеличьте изображение до 600,1000, чтобы повторить картинку в точности.

TFun[a_?MatrixQ, b_?VectorQ] := Compile[{{x, _Real, 1}}, {a.x + b}];

(* Prepare a set of function for quick retrieval.
   The resulting list has an accrued weight as the first element of each
   nested list, so that the first one that's >= random_num can be chosen *)
TFunSet[t_, w_] := Block[{a, p, s, q},
   {p, a} = Transpose[w];              (* {weight, {fun arg..}}..  *)
   p = Accumulate[p]/Plus @@ p;        (* Normalize weights to 1   *)
   MapThread[{#1,t @@ #2}&,{p, a}]];   (* To {weight bound, fun}.. *) 

(* Select а random function from the given TFunSet *)
TSetSelect[set_] := Block[{r = RandomReal[]},
   Select[set, First[#] >= r &, 1][[1, 2]]];

(* Use the above and apply the resulting function to the vector x *)
TSetApply[set_, x_] := First[TSetSelect[set][x]]

Block[{
  ITER = 10000,
  tset = TFunSet[TFun, {
     {0.01, {{{0, 0}, {0, 0.16}}, {0, 0}}},
     {0.85, {{{0.85, 0.04}, {-0.04, 0.85}}, {0, 1.6}}},
     {0.07, {{{0.22, -0.26}, {0.23, 0.22}}, {0, 1.6}}},
     {0.07, {{{-0.15, 0.28}, {0.26, 0.24}}, {0, 0.44}}}
     }]},

 Rasterize @ ListPlot[NestList[TSetApply[tset, #] &, {0, 0}, ITER],
   PlotStyle -> {PointSize[0.005], RGBColor[0, 7/8, 0]},
   ImageSize -> {300, 500},
   AspectRatio -> Full
   ]]

Хозяйке на заметку. Без Rasterize[...] результат будет очень громоздким, и Front End будет его долго форматировать, а так он превращается в растровое изображение еще в ядре, и отрисовывается моментально.