Related
I'm new here and I've one question about the Manipulate function i Mathematica: I need to plot some data of a nested list where the first coordinate selects a category (of stocks, like banks, automobiles, pharmaceuticals, ...) and inside every category there are years and months coordinates, so it should be something like
In:= list[[cat]][[yr]][[mnth]]
Out= {1,2,3,4,5,6}
which are sorted stock prices belonging to category cat.
Now I'd like to plot this with an dynamic index in Manipulate with a PopupMenu which allows to select the category i need to plot: I already have a vector sect which at position cat has the sector referring to cat in list (which is to say sect[[i]] is the category of list[[i]]), but results are poor.
I've tried to use Manipulate[...,{index,sect}] and it seems to be the right way since there actually is a popup menu in the output, but it still gives error about syntax in the control cycle I need to plot only the right sector, something like
If[ sect[[j]] == index, Plot[ list[[j]] ] ].
So I'm stuck here, thanks to anyone will help!
I'm not convinced your data structure is optimal, but here's a sample set of data:
data2 = {
{"stock",
{
Range[6], Range[6, 12],
Range[12, 18]
},
{
Range[18, 24], Range[24, 30],
Range[30, 36]
}
},
{"bank",
Table[Range[i, i + 5], {i, 1, 18, 6}],
Table[Range[i, i + 5], {i, 18, 30, 6}]
}
};
and the Manipulate:
Manipulate[ListPlot[data2[[cat, year, month]]],
{{cat, 1, "Category"}, {1 -> "stock", 2 -> "bank"},
ControlType -> PopupMenu},
{{year, 2, "Year"}, {2 -> "2010", 3 -> "2011"},
ControlType -> PopupMenu},
{{month, 1, "Month"}, {1 -> "Jan", 2 -> "Feb", 3 -> "Mar"},
ControlType -> PopupMenu}]
I am trying to dynamically plot data contained in a matrix with Mathematica 7. The data is contained in it like this, obtained via a chemical model.
[year H He Li C ... C8H14+,Grain- ]
[0 0 0.03 0.009 1E-3 ... 0 ]
[100 .1 0.03 0.009 1E-3 ... 0 ]
[200 .2 0.03 0.009 1E-3 ... 0 ]
[300 .2 0.03 0.009 1E-3 ... 0 ]
[... ... ... ... ... ... ... ]
[1E6 .5 0.03 0.003 1E-8 ... 1E-25 ]
The truth is, the matrix dimensions are 2001*1476 (2000 steps and first line for name, and 1475 compounds + 1 column for year), very heavy.
I am trying to plot any compound with a concentration / year plot. This works
Manipulate[
ListLogLogPlot[data[[All, {1, i}]], PlotLabel -> data[[1, i]] ],
{{i, 2, "Compound"}, 2, compounds, 1}
]
where data is the matrix, and compounds a variable set at the number of modelized compounds (1475 here). "compound" is a label for the slider.
The problem is, the slider moves much to fast as a few centimeters browse through 1400+ items.
I tried to do a drop-down menu with
MenuView[
Table[
ListLogLogPlot[data[[All, {1, i}]],PlotLabel -> data[[1, i]]], {i, 2, compounds}
]
]
It also works, but this is a processor killer process (10+ minutes on a Xeon 16-core server executing 16 kernels), as Mathematica try to graph all plots before displaying any of them. Also the drop-down has no name, just a series of numbers (1 for hydrogen to 1475 for C8H14N+,Grain-), even though the plot has a name.
What I am searching a way to plot a graph only on demand, with a name display in the drop-down list (and if required H by default). OR a field where I can enter the name of the compound. This seems to be possible with Dynamic[ ] command, but I don't manage to make it work properly.
Thanks
Mike's suggestion is a good one but if you don't want to go to the effort of putting it in a database, use the ContinuousAction->False option.
testdata =
Join[{Table[ToString[series[i-1]], {i, 1475}]},
RandomReal[{1., 100.}, {2000, 1476}]];
Manipulate[
ListLogLogPlot[testdata[[All, {1, i}]],
PlotLabel -> testdata[[1, i]]], {{i, 2, "Compound"}, 2, 1475, 1},
ContinuousAction -> False]
To get a popup menu, use the {i,listofvalues} syntax for the controller specification.
Manipulate[
ListLogLogPlot[testdata[[All, {1, i}]],
PlotLabel -> testdata[[1, i]]], {i, Range[2, 1475]},
ContinuousAction -> False]
This works pretty fast on my system. (Two year old MacBook Pro)
A fancier version:
spec = Thread[Range[2, 1476] -> Table[ToString[series[i]], {i, 1475}]];
Manipulate[
ListLogLogPlot[testdata[[All, {1, i}]],
PlotLabel -> testdata[[1, i]]], {{i, 2, "Compound"}, spec},
ContinuousAction -> False]
And if all you want to do is step through the images, click on the little plus next to a slider controller to get more detailed controls.
For entering names in an InputField, you could do something like
compounds = Rest[data[[1]]];
Manipulate[
If[MemberQ[compounds, compound], i = Position[compounds, compound][[1, 1]] + 1];
ListLogLogPlot[data[[All, {1, i}]], PlotLabel -> data[[1, i]]],
{{i, 2}, None},
{{compound, data[[1, 2]], "Compound"}, InputField[#, String] &}]
Here, compounds is a list of all the names of the compounds. The If statement in Manipulate is to check whether the name entered in the InputField is a valid compound or not.
Others have already given you ways to create one big popup list. If you don't want to scroll through a popup list of 1475 compounds, you could consider splitting the popup list into sublists. For example, this would split the whole list of compounds into sublists of n=50 elements which might make it easier to navigate
compounds = Rest[data[[1]]];
With[{n = 50},
Manipulate[
i = 1 + Position[compounds, name][[1, 1]];
ListLogLogPlot[data[[All, {1, i}]], PlotLabel -> data[[1, i]]],
{{i, 2}, None},
{{indexlist, 1, "Indices"},
Table[i -> ToString[(i - 1) n + 1] <> " through " <>
ToString[Min[i n, Length[compounds]]],
{i, Ceiling[Length[compounds]/n]}], PopupMenu},
{{name, compounds[[1]], "Compound"},
compounds[[n (indexlist - 1) + 1 ;;
Min[Length[compounds], n indexlist]]], PopupMenu}
]
]
For example, for
data = Table[Join[{i}, RandomReal[{0, 1}, 1000]], {i, 1000}];
data = Join[{Prepend[Table["list " <> ToString[i], {i, 1000}], "year"]}, data];
this looks like
For data sets of this size I'd recommend (as optimal) storing it all in a database and using DatabaseLink to call stuff as required. Then link your controllers, such as popup menus, to SQLExecute code or other SQL functions. Fragments like this would be the sort of thing that would do the job:
DynamicModule[{x,data, ...},
Column[{
PopupMenu[Dynamic[x], {1 -> "category 1", 2 -> "category 2", 3 -> "category 3", ...}],
Dynamic[
data = SQLExecute[conn, "SELECT * FROM myDatabase.table WHERE my_id = `1`;", {x}];
ListLogLogPlot[data]
]
}]
]
In reality you may want to be adding additional popups and doing joins and so on.
EDIT
Alternative that doesn't use databases but uses input fields as requested:
DynamicModule[{x = "He", rules, y},
rules = Rule ### Transpose[{data[[1, All]], Range[Length[data[[1, All]]]]}];
Column[{
InputField[Dynamic[x], String],
Dynamic[
y = x /. rules;
ListLogLogPlot[data[[All, {1, y}]], PlotLabel -> data[[1, y]]]
]
}]
]
For rules lists of this size you'd probably want to use Dispatch I'd imagine. See how the timing goes for that. It looks like this is some sort of experiment you are running so my first choice remains dumping it into a DB.
FURTHER EDIT
If you're relying on input fields then you will need to account for clumsy typing by inserting a conditional so that Mma only attempts to plot if y is an integer.
If[IntegerQ[y],
ListLogLogPlot,
Spacer[0]
]
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.)
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.
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}]