11
$\begingroup$

I want to combine Manipulate with ManbelbrotSetPlot just to get Mathematica to give me a quick and dirty Mandelbrot Zoomer. I want to be able to single/double click on a section, and have it zoom in on that section. All I've been able to get is an adjustable viewing window, but that's really not satisfactory. I imagine a Locator might do the trick, but I'm unsure how to get it to work. How might I accomplish this?

$\endgroup$
  • 2
    $\begingroup$ Interesting question, sadly, with no effort shown on your side it will be hard to get enough attention to it $\endgroup$ – Sektor Jun 2 '15 at 18:08
  • 2
    $\begingroup$ What do you suggest I try? $\endgroup$ – Reinstate Monica Jun 2 '15 at 18:09
  • 1
    $\begingroup$ Here is how to zoom in on a Koch curve, it can probably be adapted. There are several other questions about zooming as well that you might take a look at. $\endgroup$ – C. E. Jun 2 '15 at 18:23
  • $\begingroup$ @Pickett That's really interesting. I'm going to have to spend quite some time to figure out how it works. $\endgroup$ – Reinstate Monica Jun 2 '15 at 18:39
  • $\begingroup$ There is also this. $\endgroup$ – wxffles Jun 2 '15 at 23:17
7
$\begingroup$

Another way to zoom around is using Manipulate. Here we use a 2D slider to set the position and a regular slider to set the zoom. It scrolls more evenly if you hold down the option key as you move the sliders.

Manipulate[b = -Log[a]; 
 MandelbrotSetPlot[{u[[1]] + u[[2]] I - b - b I, u[[1]] + u[[2]] I + b + b I}, 
  MaxIterations -> 200], {{a, 0.50, "zoom"}, 0, 0.999}, {u, {-2, -1.3}, {0.6, 1.3}}]

enter image description here

|improve this answer|||||
$\endgroup$
19
$\begingroup$

Quick&Dirty:

pt = {0, 0};    
full = MandelbrotSetPlot[];
r = 0.2;

Column[{
  Row[{"Zoom: ", Slider[Dynamic[r], {0.01, 1}]}],
  Row[
   {
    LocatorPane[Dynamic[pt], 
     Dynamic[Show[full, 
       Graphics[{EdgeForm[Red], Transparent, 
         Rectangle[pt + r, pt - r]}], ImageSize -> Scaled[.45]]]],
    Dynamic[
     MandelbrotSetPlot[{pt + r, pt - r}.{1, I}, 
      ImageSize -> Scaled[.45]], TrackedSymbols :> {pt, r}]
    }]
  }]

enter image description here

|improve this answer|||||
$\endgroup$
  • $\begingroup$ This looks really nice, unfortunately it is aborting in my copy of Mathematica 10 with the error Set::write: "Tag Span in {-0.7,0.4};;full is Protected." $\endgroup$ – Reinstate Monica Jun 2 '15 at 19:36
  • $\begingroup$ Ok, now it's working. $\endgroup$ – Reinstate Monica Jun 2 '15 at 19:37
  • $\begingroup$ This is wonderful. Thank you so much. $\endgroup$ – Reinstate Monica Jun 2 '15 at 19:39
9
$\begingroup$

Here is a less quick and dirty version that includes a few more features. To zoom in, you simply click and drag to select a rectangle. Generally, you've got to hit the Generate button to produce the next picture. If you just click on the image, then a picture of the corresponding Julia set will be printed to the notebook, together with the command to generate it.

enter image description here

The code is as follows:

(* Adjust as desired *)
imageSize = 800;
defaultBailout = 100;
bailoutOptions = {50, 100, 200, 500, 1000, 2000, 5000};
defaultResolution = 400;
resolutionOptions = {400, 800, 1600};
defaultColorScheme = "StarryNightColors"
colorSchemes = ColorData["Gradients"];

(* Initial settings *)
pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};
plotRange = {{-2, 0.6}, {-1.3, 1.3}};

Manipulate[
 DynamicModule[{},
  toShow = Show[{mandelbrotPic, Graphics[{
       Thickness[0.005], Opacity[0.5], Gray,
       Dynamic@Line[{pt1, {pt1[[1]], pt2[[2]]}, pt2,
          {pt2[[1]], pt1[[2]]}, pt1}]
       }]}, FrameTicks -> False, PlotRange -> Dynamic@plotRange];
  Deploy[If[showBounds === True,
    Labeled[
     EventHandler[toShow,
      {"MouseClicked" :> With[{cmd = 
       Hold[JuliaSetPlot[#]]&[{1, I}.MousePosition["Graphics"]]},
       CellPrint[{ExpressionCell[Defer @@ cmd, "Input"], 
                  ExpressionCell[ReleaseHold[cmd], "Output"]}]],
       "MouseDown" :> (pt2 = pt1 = pt = MousePosition["Graphics"]),
       "MouseDragged" :> (pt2 = pt = MousePosition["Graphics"]),
       "MouseUp" :> (pt2 = pt = MousePosition["Graphics"])}],
     {pt1, pt2}],
    EventHandler[toShow,
     {"MouseClicked" :> With[{cmd = 
       Hold[JuliaSetPlot[#]]&[{1, I}.MousePosition["Graphics"]]},
       CellPrint[{ExpressionCell[Defer @@ cmd, "Input"], 
                  ExpressionCell[ReleaseHold[cmd], "Output"]}]],
      "MouseDown" :> (pt2 = pt1 = pt = MousePosition["Graphics"]),
      "MouseDragged" :> (pt2 = pt = MousePosition["Graphics"]),
      "MouseUp" :> (pt2 = pt = MousePosition["Graphics"])}]]]],
 Row[{
   Button["Generate",
    plotRange = {{pt1[[1]], pt2[[1]]}, {pt1[[2]], pt2[[2]]}};
    mandelbrotPic = 
     MandelbrotSetPlot[{pt1[[1]] + pt1[[2]]*I, 
       pt2[[1]] + pt2[[2]]*I},
      MaxIterations -> bail, ImageResolution -> resolution, 
      ImageSize -> imageSize,
      ColorFunction -> colorScheme],
    Method -> "Queued"
    ],
   Button["Reset",
    bail = defaultBailout; 
    resolution = defaultResolution;
    colorScheme = defaultColorScheme;
    plotRange = {{-2, 0.6}, {-1.3, 1.3}};
    mandelbrotPic = MandelbrotSetPlot[{-2.0 - 1.3 I, 0.6 + 1.3 I},
      MaxIterations -> bail, ImageResolution -> resolution, 
      ImageSize -> imageSize,
      ColorFunction -> colorScheme];
    pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};]}],
 {{bail, defaultBailout, "Bailout"}, bailoutOptions, 
  ControlType -> SetterBar}, 
 {{resolution, defaultResolution, "Resolution"}, resolutionOptions},
 {{colorScheme, defaultColorScheme, "Color Scheme"}, colorSchemes},
 {{showBounds, False, "Show PlotRange"}, {True, False}},
 Initialization :> (
   pt = {0, 0}; pt1 = {-2, -1.3}; pt2 = {0.6, 1.3};
   plotRange = {{-2, 0.6}, {-1.3, 1.3}};
   mandelbrotPic = MandelbrotSetPlot[{-2.0 - 1.3 I, 0.6 + 1.3 I},
     MaxIterations -> bail, ImageResolution -> resolution, 
     ImageSize -> imageSize,
     ColorFunction -> colorScheme];)
 ]
|improve this answer|||||
$\endgroup$
  • $\begingroup$ This is very nice to play with! Something that annoys me about MandelbrotSetPlot is that increasing the MaxIterations will make some interesting features very faint, and will only highlight the inner edges. However, not increasing MaxIterations will not reveal those interesting features. Perhaps something like this can be a fix: Colorize[HistogramTransform@ Image@First@ MandelbrotSetPlot[{-0.924 + 0.33 I, -0.913 + 0.316 I}, MaxIterations -> 1000, ImageResolution -> 1000, ColorFunction -> GrayLevel], ColorFunction -> "BeachColors"] $\endgroup$ – Szabolcs Mar 26 '17 at 15:37
  • $\begingroup$ Of course, this has its own issues too. Sometimes just raising the image to a power less than 1 is better. 11.1 supports direct image arithmetic. $\endgroup$ – Szabolcs Mar 26 '17 at 15:38
  • 1
    $\begingroup$ @Szabolcs Thanks! Your complaint is a consequence of the way that iteration counts behave and the fact that those counts are mapped linearly to the colors. One solution is to manipulate those counts inside the ColorFunction. Compare ColorFunction -> "BeachColors" to ColorFunction -> If[#3 == 1, Black, ColorData["BeachColors"][#3^(0.4)]] &), for example. I guess that's essentially what you're doing when you raise the image to a power, though I suspect you have finer control when working with the ColorFunction. It is a little slower, though. $\endgroup$ – Mark McClure Mar 26 '17 at 16:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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