# 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[x_, y_] := {x/2, y/2}
F[x_, y_] := {x/2 + 1/2, y/2}
F[x_, y_] := {x/2, y/2 + 1/2}
Do[Do[x = Random[];y = Random[]; {x, y} = F[RandomInteger][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[]; – MarcoB Aug 1 '17 at 18:24
• @MarcoB: Thank you. Fixed. – user64494 Aug 1 '17 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][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. – MarcoB Aug 1 '17 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. – user64494 Aug 1 '17 at 18:33
• +1 because it looks like the mathematica logo almost in the center – William Aug 1 '17 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[{x_, y_}] := {x, y}
v[{x_, y_}] := {Sin[x], Cos[x]}
v[{x_, y_}] := Normalize[{x, y}]
v[{x_, y_}] := With[{rsquare = SquaredEuclideanDistance[x, y]}, {x Sin[rsquare] - y Cos[rsquare], x Cos[rsquare] + y Sin[rsquare]}]
v[{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? – user64494 Aug 1 '17 at 18:41
• @user64494 What do you mean by "general" here? – MarcoB Aug 1 '17 at 18:42
• I have in mind arbitrary functions $F[i]$ and more complicated flames. – user64494 Aug 1 '17 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. – MarcoB Aug 1 '17 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... ;-) – MarcoB Aug 1 '17 at 19:09