1
$\begingroup$

See Wiki and the description here . enter image 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

Improve this question
$\endgroup$
6
  • $\begingroup$ 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[]; $\endgroup$
    – MarcoB
    Commented Aug 1, 2017 at 18:24
  • $\begingroup$ @MarcoB: Thank you. Fixed. $\endgroup$
    – user64494
    Commented Aug 1, 2017 at 18:25
  • $\begingroup$ 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. $\endgroup$
    – MarcoB
    Commented Aug 1, 2017 at 18:28
  • $\begingroup$ @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. $\endgroup$
    – user64494
    Commented Aug 1, 2017 at 18:33
  • $\begingroup$ +1 because it looks like the mathematica logo almost in the center $\endgroup$
    – William
    Commented Aug 1, 2017 at 18:51

1 Answer 1

Reset to default
3
$\begingroup$

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

Mathematica graphics

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

Mathematica graphics

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

Improve this answer
$\endgroup$
7
  • $\begingroup$ +1. How about the general case? $\endgroup$
    – user64494
    Commented Aug 1, 2017 at 18:41
  • $\begingroup$ @user64494 What do you mean by "general" here? $\endgroup$
    – MarcoB
    Commented Aug 1, 2017 at 18:42
  • $\begingroup$ I have in mind arbitrary functions $F[i]$ and more complicated flames. $\endgroup$
    – user64494
    Commented Aug 1, 2017 at 18:45
  • $\begingroup$ @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. $\endgroup$
    – MarcoB
    Commented Aug 1, 2017 at 19:00
  • 2
    $\begingroup$ @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... ;-) $\endgroup$
    – MarcoB
    Commented Aug 1, 2017 at 19:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.