5
$\begingroup$

inspired by the attached fractal image, how can I generate the same effect with MMA, but with the possibility of inserting a specific text?

Any help is welcome, thank you in advance.

Spiral fractal, reference image

Improve this question
$\endgroup$
6
  • $\begingroup$ Please post any work that you have so far. The effect seems to require that the last letter looks like the first when rotated 90 degrees, the way that T looks like E when rotated 90 degrees, with this particular font. Do you have a word in mind, or a font? $\endgroup$ Commented Jan 16 at 13:14
  • $\begingroup$ The text would be in Spanish "IV Olimpiada de Mátemática", it does not matter that it is not so exact, the truth is to present an unusual idea,I have looked for something similar in previous posts but I can't find any code to do it, I just started with MMA, it is difficult for me to understand some things $\endgroup$ Commented Jan 16 at 19:01
  • $\begingroup$ I don't have the time to figure out how to get the fractal effect but here's a start. getText[text_, r_, theta_] := Translate[Rotate[Text[text], theta], {-r Sin[theta], r Cos[theta]}] Manipulate[ Graphics[{ White, Table[ getText[ Style["IV Olimpiada de Mátemática", FontSize -> 2 (theta + offset)/Pi ], 0.7 (theta + offset)/Pi, (theta + offset)] , {offset, 0, 100, Pi/2}] }, Background -> Black, PlotRange -> 10 ], {theta, 0, 10 Pi} ] $\endgroup$ Commented Jan 18 at 0:33
  • $\begingroup$ Hello, thanks for answering, I just saw this, I ran it but nothing appears, could you give some example of execution that concludes with an animated gif as output, nothing complex, to study what you sent me $\endgroup$ Commented Jan 18 at 0:48
  • $\begingroup$ The issue might be that you need a newline between the function definition and Manipulate. It was removed when posting the code as a comment. And again, please note that this is just a rough start. $\endgroup$ Commented Jan 18 at 1:51

2 Answers 2

Reset to default
5
$\begingroup$

The answer may not be exactly what you were looking for, but I have recreated something similar to the GIF shown above. Below is the code I used:

generatetxt[cont_, {cx_, cy_}, r_, theta_] := 
 Rotate[Text[
   Style[cont, FontSize -> r  220, Bold, 
    FontFamily -> "Times New Roman"], {cx, cy}, {0, 0}], theta]
generatesequencetxt[sequence_] := 
 Module[{}, 
  MapThread[
   generatetxt[#1, Sequence @@ #2] &, {{"T", "R", Rotate["T", Pi/2], 
     Rotate["T", Pi/2]}, sequence}]]
generateSequence[pi_, r1_, r_, angle_] := 
 Module[{norm = {Cos[angle], Sin[angle]}, pts, rL, rL1},
  rL = {r1, r, r, r}; rL1 = Accumulate[{0, r1/2 + r/2, r, r}]; 
  pts = Table[{pi + norm *rL1[[i]], rL[[i]], angle}, {i, 1, 4}]]

iteration[sequence_] := Module[{rc, anglec, rn}
  , rc = sequence[[-1, 2]]
  ; anglec = sequence[[-1, 3]]
  ; Sequence @@ {generateSequence[sequence[[3, 1]], rc, rc  0.65, 
     anglec - Pi/2], 
    generateSequence[sequence[[4, 1]], rc, rc  0.65, anglec + Pi/2]}]
Manipulate[x = 0.5 Exp[0.2  t]  Cos[t]; y = 0.5 Exp[0.2  t]  Sin[t]; 
 res = generatesequencetxt /@ 
   Flatten[NestList[((iteration /@ #) &), {generateSequence[{x, y}, 
       Sqrt[x^2 + y^2], Sqrt[x^2 + y^2]  0.65, ArcTan[x, y] - 2.5]}, 
     6], 1];
 Graphics[{White, res[[1]], res[[2 ;;, 2 ;;]]}, Background -> Black, 
  PlotRange -> {{-1, 1}, {-1, 1}}], {t, 5, 3}, TrackedSymbols :> {t}, 
 SynchronousUpdating -> False]

Please note that this is just a rough version. Hopefully, it can inspire you and help you achieve the desired outcome. enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ wow thanks for your time this gives me a good idea of ​​how to continue just one thing I see that the gif cuts off very quickly it could have an infinite loop $\endgroup$ Commented Jan 18 at 15:18
6
$\begingroup$

  • Needs time to show the idea.

  • the structure of the fractal tree.

Clear["Global`*"];
λ = .5;
l0 = {{{0, 0}, {0, 100}}, "Left"};
rotate[{{x1_, y1_}, {x2_, y2_}}, angle_, 
   relative_] := {(1 - relative) {x1, y1} + 
    relative {x2, y2}, (1 - relative) {x1, y1} + relative {x2, y2} + 
    RotationTransform[angle][λ ({x2, y2} - {x1, y1})]};

add[{{{x1_, y1_}, {x2_, y2_}}, type_}] := 
 Which[type == "Left", 
  Return[{{rotate[{{x1, y1}, {x2, y2}}, 90 Degree, 1.], 
     "Left"}, {rotate[{{x1, y1}, {x2, y2}}, -90 Degree, .5], 
     "Right"}}], type == "Right", 
  Return[{{rotate[{{x1, y1}, {x2, y2}}, -90 Degree, 1.], 
     "Right"}, {rotate[{{x1, y1}, {x2, y2}}, 90 Degree, .5], "Left"}}]]
n = 5;
list = NestList[Flatten[add /@ #, 1] &, {l0}, n];
Graphics[{Map[{#[[2]] /. {"Right" -> Red, "Left" -> Blue}, 
     Line[#[[1]]]} &, list, {2}]}]

enter image description here

  • the fonts. ( For version 14.1,we can remove _Text in BoundaryDiscretizeGraphics)
r = BoundaryDiscretizeGraphics[
   Text[Style["R", FontFamily -> Times]], _Text];
t = BoundaryDiscretizeGraphics[
   Text[Style["T", FontFamily -> Times]], _Text];
reg = RegionUnion[TransformedRegion[r, RotationTransform[-90 Degree]],
    TransformedRegion[t, TranslationTransform[{0, -8}]], 
   TransformedRegion[t, TranslationTransform[{0, -16}]]];
{{xmin, xmax}, {ymin, ymax}} = RegionBounds[reg];
{a, b, c, 
   d} = {{xmin, ymin}, {xmax, ymin}, {xmax, ymax}, {xmin, ymax}};
reg = ScalingTransform[.95 {1, 1}]@reg

enter image description here

  • add the fonts to the fractal tree.
factor = .68;
M = Mean[{a, b, c, d}];
translate1[{p_, q_}] := 
  GeometricTransformation[reg, 
   TranslationTransform[factor*q + (1 - factor) p - M]@*
    RotationTransform[{{0, -1}, q - p}, M]@*
    ScalingTransform[Norm[q - p]/Norm[d - a]*{1, 1}, M]];
translate2[{p_, q_}] := 
 GeometricTransformation[ReflectionTransform[{1, 0}, M]@reg, 
  TranslationTransform[factor*q + (1 - factor) p - M]@*
   RotationTransform[{{0, -1}, q - p}, M]@*
   ScalingTransform[Norm[q - p]/Norm[d - a]*{1, 1}, M]]; Graphics[
 Map[{Which[#[[2]] == "Left", {Blue, translate1@#[[1]]}, #[[2]] == 
      "Right", {Red, translate2@#[[1]]}]} &, list, {2}]]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ This is a useful template. +1 :) $\endgroup$ Commented Jan 23 at 8:48
  • 1
    $\begingroup$ @ubpdqn Thanks! I think maybe Lindenmayer system is helpful here, but I have less knowledge. $\endgroup$ Commented Jan 23 at 8:53

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.