dynamic interactivity problem - dynamic

I am trying to have two panels, the left showing a graphic and two locators, the right one a zoomed-in version in the area defined by the locators.
I've tried
ClearAll[mndpt];
mndpt = Compile[{{c, _Complex}, {maxiter, _Integer}},
Module[{z, iters},
iters = 0.;
z = c;
While[(iters < maxiter) && (Abs#z < 2),
iters++;
z = z^2 + c];
Sqrt[iters/maxiter]],
{{z, _Complex}},
CompilationTarget \[Rule] "C",
RuntimeOptions \[Rule] "Speed"];
and do
Manipulate[
Grid[
{{DensityPlot[mndpt[x + y*I, 200],
{x, -2, 1}, {y, -1.5, 1.5},
PlotRange \[Rule] {0, 1}, PlotPoints \[Rule] 80,
ColorFunction \[Rule] "Rainbow"],
DensityPlot[mndpt[x + y*I, 200],
Dynamic#{x, p1[[1]], p2[[1]]}, Dynamic#{y, p1[[2]], p2[[2]]},
PlotRange \[Rule] {0, 1}, PlotPoints \[Rule] 80,
ColorFunction \[Rule] "Rainbow"]}}],
{{p1, {-1, -1}}, Locator}, {{p2, {0, 1}}, Locator}]
The right panel does not then work:
My question is, why is this so? As you can see, it complains that "DensityPlot::pllim: Range specification {x,-1,0} is not of the form {x, xmin, xmax}. " which I find puzzling. In fact I am generally puzzled. What is going on? Some sort of scoping issue? Evaluation issue? And how can I get it to work? This is probably simple, but I never really understood this frontend stuff.
EDIT: It turns out that this question was due to a (hopefully momentary) sharp increase in stupidity on my part. As pointed out by Simon in a comment, removing the two Dynamics
(which I had added in a blind effort to make this work) makes everything work fine. That is,
Manipulate[
Grid[
{{DensityPlot[mndpt[x + y*I, 200],
{x, -2, 1}, {y, -1.5, 1.5},
PlotRange \[Rule] {0, 1}, PlotPoints \[Rule] 80,
ColorFunction \[Rule] "Rainbow"],
DensityPlot[mndpt[x + y*I, 200],
{x, p1[[1]], p2[[1]]},{y, p1[[2]], p2[[2]]},
PlotRange \[Rule] {0, 1}, PlotPoints \[Rule] 80,
ColorFunction \[Rule] "Rainbow"]}}],
{{p1, {-1, -1}}, Locator}, {{p2, {0, 1}}, Locator}]
does the right thing:
So, who knows why else I did the first few times so that it didn't work.
On the other hand, the message in the original case, namely, "DensityPlot::pllim: Range specification {x,-1,0} is not of the form {x, xmin, xmax}. " was more puzzling. I think it's been explained by Leonid, also in a comment (in brief, try ClearAttributes[Dynamic, ReadProtected] then ??Dynamic and you can see that there is a definition Dynamic/:MakeBoxes[BoxForm`x$_Dynamic,StandardForm]:= etc). As my understanding of frontend programming is negligible I won't try to explain it here, so if anybody does post an answer explaining that, it would be appreciated.

As discussed in the comments to the question, the code works fine if the Dynamics are removed from the ranges in the second DensityPlot. The Dynamics are not normally needed in the body of a Manipulate as it is automatically wrapped in a dynamic construct. Although, for a more fine grained control of which parts of an expression update, it can be useful to use Dynamic inside of a Manipulate.
The reason an error was created was because the range of a plot should be of the form {x, xmin, xmax} with x a Symbol and xmin and xmax numeric. Wrapping Dynamic around the list changes the head and breaks the plot.
The reason that the error was not obvious to spot is because the error message was a little confusing:
Range specification {x,-1,0} is not of the form {x, xmin, xmax}.
Which, on the surface looks crazy, but makes sense once you realise (as pointed out by Leonid) that Dynamic is a wrapper that has a MakeBoxes definition that makes it invisible when outputted to the notebook. To see this, look at
In[1]:= FormatValues[Dynamic]
Out[1]= {HoldPattern[MakeBoxes[BoxForm`x$_Dynamic, StandardForm]] :> (DynamicModule;
DynamicDump`ControlToBoxes[BoxForm`x$, StandardForm]),
<<snip: same but for TraditionalForm>>}
and ControlToBoxes in turn, creates a DynamicBox object. This can also be seen by entering Dynamic[x] and using the cell menu or shortcut to Show Expression of the produced output cell - you can also look at the underlying expression of the error message and see the DynamicBox construction there. It's also possible to Unprotect and remove the MakeBoxes definition of Dynamic, but that breaks most of the dynamic functionality in Mathematica...
Finally, here's my version of the code:
mndpt = Compile[{{c, _Complex}, {maxiter, _Integer}},
Module[{z = c, iters = 0.0},
While[(iters < maxiter) && (Abs#z < 2), iters++; z = z^2 + c];
Sqrt[iters/maxiter]], CompilationTarget -> "C",
RuntimeOptions -> "Speed"];
opts = Sequence[PlotPoints -> 80, ColorFunction -> "Rainbow",
ImageSize -> Medium, ImagePadding -> {{30, 5}, {20, 5}}];
fixed = DensityPlot[mndpt[x + y*I, 200], {x, -2, 1}, {y, -1.5, 1.5},
PlotPoints -> 120, Evaluate[opts]];
Manipulate[Grid[{{fixed, DensityPlot[mndpt[x + y*I, 200],
{x, p[[1, 1]], p[[2, 1]]}, {y, p[[1, 2]], p[[2, 2]]}, Evaluate[opts]]}}],
{{p, {{-1, -1}, {0, 1}}}, Locator, ContinuousAction -> False}]

Related

VBA - How do I find the name of a shape created from an effect?

I was wondering if there is a more specific way to rename my shape extracted from a contour effect than using ActiveLayer.Shapes(2)? The main thing I don't like about this method is it's general and I'm afraid that somewhere down the road it might not be Shape(2) anymore, causing issues. My hope is to define it by name, but I don't know what that is since it's created via an effect.
Is there by chance a function or something to look up an unknown shape name?
I found .findeshape, but I couldn't get it to work and I'm not sure if that's what I actually need in this instance. Any help is appreciated.
'Create Rectangle
Set Rect = ActiveLayer.CreateRectangle(1, 1, 0, 0)
'Apply .1" Outside Contour.
Set Contour1 = ActiveLayer.Shapes(1).CreateContour(cdrContourOutside, 0.1, 1, cdrDirectFountainFillBlend, CreateCMYKColor(75, 68, 65, 90), CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 15#)
ActiveDocument.CreateSelection Contour1.Contour.ContourGroup, ActiveLayer.Shapes(1)
ActiveSelection.Separate
ActiveLayer.Shapes(2).ObjectData("Name").Value = "Renamed 2"
End Sub```

Formatting Manipulate output to have 2 cells in Mathematica

The following output code outputs an array from the manipulate statement. I would like to output the fitting and plot as two separate output cells that update dynamically. I think it should be pretty simple, but I am having trouble with it. I've tried using the CellPrint[] function, but did not get it to work.
Thanks,
Tal
temperatures(*mK*)= {300, 200, 150, 100, 75, 50, 25, 11, 10};
F[t_, \[Nu]_] := t^\[Nu];
rd (*uOhms*)= {27173.91304, 31250., 42372.88136, 200601.80542,
1.05263*10^6, 1.33333*10^7, 1.33333*10^8, 2.*10^8, 2.1*10^8};
logRd = Log10[rd];
f[\[Nu]0_] := Module[{\[Nu]},
\[Nu] = \[Nu]0;
data = Transpose[{F[temperatures, \[Nu]]*10^3, logRd}];
fitToHexatic = LinearModelFit[data[[4 ;; 6]], x, x];
plota =
Plot[fitToHexatic["BestFit"], {x, 0, data[[-1]][[1]]},
Axes -> False];
plotb = ListPlot[data, Axes -> False];
{fitToHexatic, Show[{plota, plotb}, Axes -> True]}
]
Manipulate[
f[nu],
{nu, -0.2, -1}
]
Screenshot of the output:
You don't need to use a Manipulate. You can get more control with lower level functions. E.g.
Slider[Dynamic[nu, (f[#]; nu = #) &], {-0.2, -1}]
Dynamic[Normal[fitToHexatic]]
Dynamic[Show[{plota, plotb}, Axes -> True]]
See also Prototypical Manipulate in lower level functions.

Mathematica: Having a plot inside a loop of a module updated

I would like to have a module like this
TestModule[n_] := Module[{{dataList = {{0, 0}, {1, 2}}}},
For[i = 1, i <= n, i++,
Pause[0.5];
Print[ ListLinePlot[dataList++]];
];
];
where a the values of a list get updated from iteration to iteration and instead of having the module producing me n plots, I rather would like to have only one plot, which is updated n times after each iteration.
I looked already at Dynamics[] and Monitor[], but could not yet find a solution with them. Any help is appreciated. :)
here is a straightforward application of Monitor:
TestModule[n_] := Module[{
dataList = {{0, 0}, {1, 2}},
plot = "starting..."
},
Monitor[
Do[
Pause[0.5];
plot = ListLinePlot[dataList++, PlotRange -> {0, n + 2}],
{i, 1, n}
],
plot
];
plot
];
Do you know mathematica.stackexchange.com? You'll get much more answers for Mathematica specific questions there...

Can we decrease Bar size width in BarChart in Mathematica?

dalist = {901, 503, 522, 1305}
cogColors = {RGBColor[0, 0, 1], RGBColor[1, 0, 0], RGBColor[0, 1, 0], RGBColor[1, 1, 0]}
BarChart[dalist, ChartStyle -> cogColors]
Is it possible to decrease the Bars Width ?
I may be missing the point, but cannot you merely change the aspect ratio?
BarChart[dalist, ChartStyle -> cogColors, AspectRatio -> 3, ImageSize -> 120]
BarChart is not intended to do that. You can only change the spacings.
Use RectangleChart instead if you need finer control:
RectangleChart[{{{1, 1}, {1, 1}, {1, 1}}, {{2, 2}, {2, 2}, {2, 2}}}]
Rather than changing the bar chart width, you can increase the bar spacing.
BarChart[dalist, ChartStyle -> cogColors, BarSpacing -> 1]
See Heike's answer to my earlier question. You need to use RectangleChart. If you want to keep a constant distance between bar centres, so that the bar-plus-spacing takes up a constant space, you can use the ChartElementFunction option together with an auxiliary function, as shown in Heike's answer. (This might also do what you want using BarChart, but I'd still recommend RectangleChart.)

NMinimize eats all memory b/c of unnecessary symbolic work

The following code is a naive way to find the least number whose square has n divisors (the minimum should be its log and the x_i the powers in its prime factorization). If I look at the case n=2000 and use ten variables instead of twenty, this uses somewhere around 600MB of memory. With the value of n I'm actually trying to find the answer for, I need around 20 variables to be sure of not missing the actual solution, and it quickly uses up all available memory and then thrashes swap.
n=8*10^6;
a = Table[N[Log[Prime[i]]], {i, 20}];
b = Table[Subscript[x, i], {i, 20}];
cond = Fold[And, Product[2 Subscript[x, i] + 1, {i, 20}] > n,
Table[Subscript[x, i] >= 0, {i, 20}]] && b \[Element] Integers;
NMinimize[{a.b, cond}, b, MaxIterations -> 1000]
It turns out that the problem isn't related to integer programming etc at all (removing the restriction to the integers doesn't help).
My best guess is that the problem is that Mathematica is wasting all that memory expanding Product[2 Subscript[x, i] + 1, {i, 20}]. If I replace the product with just Product[Subscript[x, i],{i,20}] and change the constraints to be >= 1 rather than 0 I get results without a hassle and without the kernel using more than 50MB of memory. (Though that preserves the inequality constraint and doesn't change the task of minimizing the objective function, it does mess up the integrality requirement- I get even results, which correspond to half-integers in the actual problem.)
One person on StackOverflow had a similar problem; in their case, they had an objective function which was getting evaluated symbolically at a huge cost. They were able to remedy it by making the function only accept numeric input, effectively hiding it from Mathematica's "I have the Expand[] hammer, and everything looks like a nail" tendency. But you can't hide the constraint behind such a function (Mathematica will complain it's an invalid constraint).
Any thoughts on how to fix this?
Edit: I know the correct answer- after my Mathematica code didn't work I used AMPL and a dedicated MINLP solver to get it (quite quickly too). I just want to know how I can ever hope to be able to use Mathematica's built-in nonlinear optimization features in the future despite the crazy things it seems to do with my constraints when I enter them in the only way I know how.
Can inhibit that condition from doing anything unless inputs are numeric, as below.
n = 8*10^6;
nvars = 20;
a = Table[N[Log[Prime[i]]], {i, nvars}];
b = Table[Subscript[x, i], {i, nvars}];
c1[xx : {_?NumericQ ..}] := Times ## (2 xx + 1);
c2 = Map[# >= 0 &, b];
c3 = b \[Element] Integers;
cond = Join[{c1[b] > n}, c2, {c3}];
In[29]:= Timing[NMinimize[{a.b, cond}, b, MaxIterations -> 400]]
Out[29]= {43.82100000000008, {36.77416664719056, {Subscript[x, 1] ->
3, Subscript[x, 2] -> 3, Subscript[x, 3] -> 2,
Subscript[x, 4] -> 2, Subscript[x, 5] -> 1, Subscript[x, 6] -> 1,
Subscript[x, 7] -> 1, Subscript[x, 8] -> 1, Subscript[x, 9] -> 1,
Subscript[x, 10] -> 1, Subscript[x, 11] -> 1,
Subscript[x, 12] -> 1, Subscript[x, 13] -> 0,
Subscript[x, 14] -> 0, Subscript[x, 15] -> 0,
Subscript[x, 16] -> 0, Subscript[x, 17] -> 0,
Subscript[x, 18] -> 0, Subscript[x, 19] -> 0,
Subscript[x, 20] -> 0}}}
---edit---
Thought I would point out that this can be set up as an integer linear programming problem. We use 0-1 variables for all possible combinations of primes and powers.
We can limit the number of primes using the fact that the solution cannot involve more primes than the minimum needed assuming all are raised to the first power. The objective is then minimal if they are consecutive starting at 2.
We will assume the max exponent is no more than 20. There is probably a convenient way to show this but it has not come to mind as yet.
The objective and constraints, in this formulation, are as below. We get a fully linear problem by taking logs of the divisor sigma equation.
n = 8*10^6;
nprimes = Ceiling[Log[2, n]];
maxexpon = 20;
vars = Array[x, {maxexpon, nprimes}];
fvars = Flatten[vars];
c1 = Map[0 <= # <= 1 &, fvars];
c2 = {Element[fvars, Integers]};
c3 = Thread[Total[vars] <= 1];
c4 = {Total[N[Log[2*Range[maxexpon] + 1]].vars] >= N#Log[n]};
constraints = Join[c1, c2, c3, c4];
obj = Range[maxexpon].vars.N[Log[Prime[Range[nprimes]]]];
Timing[{min, vals} = NMinimize[{obj, constraints}, fvars];]
Out[118]= {5.521999999999991, Null}
Pick[fvars, fvars /. vals, 1] /. x[j_, k_] :> {Prime[k], j}
Out[119]= {{11, 1}, {13, 1}, {17, 1}, {19, 1}, {23, 1}, {29, 1}, {31,
1}, {37, 1}, {5, 2}, {7, 2}, {2, 3}, {3, 3}}
This approach handles n=10^10 is around 23 seconds.
---end edit ---
Daniel Lichtblau
You can try this code instead:
Catch[Do[If[DivisorSigma[0, k^2] > 2000, Throw[k]], {k, 1000000}]]
which returns 180180.
ADDITION:
Catch[Do[If[Times##(2 FactorInteger[k][[All, 2]] + 1) > 2000, Throw[k]], {k, 1000000}]]
Seems to work faster.
ADDITION 2:
Behold for this ultra-improved version (but not 100% proved):
MinSquareWithDivisors[n_] :=
Min#Select[
Product[Prime[k]^#[[k]], {k, 1, Length[#]}] & /#
Flatten[IntegerPartitions /# Range[Ceiling[Log[2, n]]], 1],
DivisorSigma[0, #^2] > n &]
MinSquareWithDivisors[2000000000] gives 2768774904222066200260800 in ~4 seconds
Explanation:
First of all one needs to prove that the sum of the prime's exponents in this minimum number is at most Log[2, n]. I haven't found a proof yet, but it might be related to the ratio between successive primes.
Flatten[IntegerPartitions /# Range[Ceiling[Log[2, n]]], 1] gives you all the lists with Total <= Log[2, n], conveniently sorted from large to small.
Product[Prime[k]^#[[k]], {k, 1, Length[#]}] & use them as prime's exponents to create integers.
Min#Select[..., DivisorSigma[0, #^2] > n &] choose the minimal of them that agrees with the original condition.