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?
-
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$ – silvascientist 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$ – silvascientist Jun 2 '15 at 18:39
-
$\begingroup$ There is also this. $\endgroup$ – wxffles Jun 2 '15 at 23:17
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}}]
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}]
}]
}]
-
$\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$ – silvascientist Jun 2 '15 at 19:36
-
-
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];)
]
-
$\begingroup$ This is very nice to play with! Something that annoys me about
MandelbrotSetPlot
is that increasing theMaxIterations
will make some interesting features very faint, and will only highlight the inner edges. However, not increasingMaxIterations
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
. CompareColorFunction -> "BeachColors"
toColorFunction -> 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 theColorFunction
. It is a little slower, though. $\endgroup$ – Mark McClure Mar 26 '17 at 16:00