Interactive Mandelbrot Zoomer?
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}]
}]
}]
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.
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];)
]
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}}]