# How to implement fractal flames in Mathematica?

See Wiki and the description here .

Here is my attempt to realize the pseudocode in p.3:

F[0][x_, y_] := {x/2, y/2}
F[1][x_, y_] := {x/2 + 1/2, y/2}
F[2][x_, y_] := {x/2, y/2 + 1/2}
Do[Do[x = Random[];y = Random[]; {x, y} = F[RandomInteger[2]][x, y],
20]; Print[x, y], 5]


Set::write: Tag CompoundExpression in x=Random[]; is Protected. General::stop: Further output of Set::write will be suppressed during this calculation.

0.07520640.267655B

0.8007930.190645

0.7525410.000367346

0.2011730.0475016

0.3844770.0957375

• I think you are just missing a y in your second initial definition within Do. i.e. x = Random[]; = Random[]; should be x = Random[]; y = Random[]; Commented Aug 1, 2017 at 18:24
• @MarcoB: Thank you. Fixed. Commented Aug 1, 2017 at 18:25
• You will also want to use Sow and Reap rather than Print to collect your results. Try e.g. Reap[Do[Do[x = Random[]; y = Random[]; {x, y} = F[RandomInteger[2]][x, y], 20]; Sow[{x, y}], 1000]][[2, 1]]; ListPlot[%] This generates this plot with no errors, but I am not sure whether that's what you want. Commented Aug 1, 2017 at 18:28
• @MarkoB: It's kind of you. Many thanks from me to you. Your plot is not it. The Serpinski carpet should be produced. It would be nice to create a general procedure to produce a fractal flame. Unfortunately, my skills are not sufficient to this end. Commented Aug 1, 2017 at 18:33
• +1 because it looks like the mathematica logo almost in the center Commented Aug 1, 2017 at 18:51

Using your own definitions of F[i] from OP, here is a literal implementation of the algorithm you pointed to on page 3 of the linked paper. it does not seem to produce a flame, but rather a Sierpinski triangle, as far as I understand it.

Module[{x, y},
{x, y} = RandomReal[{-1, 1}, 2];
Reap[
Do[Sow[{x, y} = F[RandomInteger[{0, 2}]][x, y]], 10000]
][[2, 1, 21 ;;]] (*take only iterations after the first 20*)
];

ListPlot[%]


Here is a more idiomatic implementation of the same algorithm in Mathematica:

ListPlot@
NestList[F[RandomInteger[{0, 2}]] @@ # &, RandomReal[{-1, 1}, 2], 10000][[21;;]]


Here are some examples of other functions that were in the original paper:

ClearAll[v]
v[0][{x_, y_}] := {x, y}
v[1][{x_, y_}] := {Sin[x], Cos[x]}
v[2][{x_, y_}] := Normalize[{x, y}]
v[3][{x_, y_}] := With[{rsquare = SquaredEuclideanDistance[x, y]}, {x Sin[rsquare] - y Cos[rsquare], x Cos[rsquare] + y Sin[rsquare]}]
v[4][{x_, y_}] := {x^2 - y^2, 2 x y}/EuclideanDistance[x, y]

NestList[v[RandomInteger[{0, 4}]][#] &, RandomReal[{-1, 1}, 2], 150000][[20 ;;]];

ListPlot[%, PlotRange -> {-10, 10}]


It is now up to you to define "interesting" functions and try them out, them find an appropriate coloring scheme, etc.

• +1. How about the general case? Commented Aug 1, 2017 at 18:41
• @user64494 What do you mean by "general" here? Commented Aug 1, 2017 at 18:42
• I have in mind arbitrary functions $F[i]$ and more complicated flames. Commented Aug 1, 2017 at 18:45
• @user64494 I added some more functions from the paper, page 5. However, there is much more to making those beautiful images than just generating some points: you will have to choose an appropriate coloring scheme, perhaps some filtering of results, etc. Commented Aug 1, 2017 at 19:00
• @user64494 I'd say that it is completely unsurprising that a single-purpose software package will do its only purpose better than a general purpose tool like Mathematica. In fact, if it didn't, there would be no point in its existence at all! Note also that all the formatting decisions have already been pre-implemented there. However, I'm sure that Mathematica beats Apophysis handily at, say, numerical and symbolic integration, formula manipulation, and cluster analysis, to name but a few random things... ;-) Commented Aug 1, 2017 at 19:09