Wolfram Matematica: set NIntegral's domain with Table - wolfram-mathematica

I would like perform an NIntegrate in Wolfram Mathematica in n-dimension, for example making the NIntegrate of the 9-dimension function:
p=Product[(1+x[i])^((-1)^i),{i,0,9}]
so I thought to set the range with a Table:
t=Table[ {x[i], 1,2}, {i,0,9}]
Unfortunately the command
NIntegrate[p,t]
returns the Error:
NIntegrate::vars:
Integration range specification t is not of the form {x, xmin, ..., xmax}.
I've tested with some commands as "Extract", "Part" and so on, but nothing works.
Someone can help a niubb as me?!
Thanks for reading!

You were almost there. Some further manipulation of the integration limits is needed:
p = Product[(1 + x[i])^((-1)^i), {i, 0, 9}]
t = Table[{x[i], 1, 2}, {i, 0, 9}]
Integrate[p, Evaluate[Sequence ## t]]
(*
3125/32 Log[3/2]^5
*)

Related

manipulating one element in a list in mathematica

I have a list of 200 data points. I want to select one value, and change the data using the manipulate function to create a bad data point, and observe the effects on the graph.
My recent attempts included creating a variable i, and assigning like:
myarray[[80,2]] = i;
and then use manipulate as such:
Manipulate[Curve[myarray], {i, 0, 5}]
This is not giving the desired output, however. It doesn't really make sense to me to put it like that, but I don't see the alternative way. Any help on this particular problem would be greatly appreciated!
Making up some data and a Curve function :-
myarray = Transpose[{Range[10], Range[10]/2}];
Curve[myarray_] := ListLinePlot[myarray]
Manipulate[myarray[[8, 2]] = i; Curve[myarray], {i, 0, 5}]
To complement Chris Degnen's answer, which shows a good approach, here is an explanation for why your original code failed.
Manipulate, like Module, acts as a scoping construct. For this reason the i used by Manipulate (the manipulation variable) is not the same i as set with myarray[[80, 2]] = i; -- it exists in a different Context:
Manipulate[Context[i], {i, 0, 5}]
(* FE` *)
Here is a minimal example of the problem:
ClearAll[x, i]
x = i;
Manipulate[{x, i}, {i, 0, 5}]
(* {i, 2.24} *)
One way around this is to use Block, but you need to use a different name for the manipulate variable:
ClearAll[x, i]
x = {1, 2, i};
Manipulate[Block[{i = ii}, x], {ii, 0, 5}]
(* {1, 2, 1.41} *)

MiniMaxApproximation not working in Mathematica 7

I'm new to Mathematica and I'm trying to obtain a minimax rational function approximation to a certain expression. In particular, I'm using
mma = MiniMaxApproximation[x^2, {x, {8, 10}, 2, 2}]
Unfortunately, Mathematica 7 replies with the same expression I'm trying to calculate, namely
MiniMaxApproximation[x^2, {x, {8, 10}, 2, 2}]
Of course, I'm aware this is a very simple test, since x^2 is the rational function approximation of itself.
I'm also trying other possibilities like RationalInterpolation, EconomizedRationalApproximation etc., but none is working. Only PadeApproximant returns a result.
Anyone has an idea on why this happens?
Thank you very much in advance.
likely your first problem is that you havent loaded the function approximation package,
start a new kernel and try this:
Needs["FunctionApproximations`"]
mma = MiniMaxApproximation[Exp[x], {x, {0, 1}, 1, 2}]
Your specific example (x^2) throws a slew of (to me) nonsensical errors. I guess MiniMaxApproximation is not robust in handling trivial degenerate cases.
evidently requesting a numerator equal to the order for your expression is causing the error:
a[x_] = MiniMaxApproximation[x^2, {x, {8, 10}, 1, 2}][[2, 1]]
Plot[ {a[x] , x^2}, {x, -10, 30}]

difference of speed in making a Table

I was reading a useful post at WRI blog on improving speed of code, and I need help in understanding this one.
Compare these speeds
Timing[
tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];
]
{0.031, Null}
and
Timing[
a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
{0.422, Null}
So it is much faster when putting the actual value for the limit inside the table itself vs outside. The explanation for this, which I am sure it is correct, but I need help in understanding, is that Table is compiled if its limit are numeric vs. not, this is because its Attributes is HoldAll.
But my question is: How would the above actually work, because the limits to Table must, at one point, become numeric anyway? I can't write
Clear[a]
tbl = Table[i + j, {i, 1, a}, {j, 1, a}]
The above gives an error.
So, for me, writing a=1000 outside Table vs. inside, should have made no difference, since without a having a numerical value, Table[] can't do anything. So the replacing of a by the number 1000 must occur at one point of time by evaluator before Table[] can do anything useful, would it not?
In other words, what Table should see, eventually, is {i, 1, 1000}, {j, 1, 1000} in both cases.
So, the way I thought this would happen is this:
Evaluator replaces a by 1000 in the arguments of table
Evaluator calls Table with the result, which is now all numeric.
Table Compiles, and runs faster now.
But what seems to happen is something else. (due to HoldAll ?)
Table takes its arguments, as is. Since it has HoldAll, so it sees a and not 1000.
It does not call Compile since its arguments are not all numbers.
It now generate a table with the a limit, Evaluator evaluates a to 1000
Table is generated now all limits are numeric, but slower now since code is not compiled.
Question is: Does the above sort of what happens? Could someone explain the steps that would have happened to explain this difference in timing?
Also, how would one insure that Table is Compiled in both cases in the above example, even if one uses a variable for the limit? It is not always possible to hardcode the numbers for the table limits, but one must sometime use a variables for these. Should one explicitly use the Compile command? (I do not use Compile directly, since I assumed it is done automatically when needed).
edit(1)
In answer to post by Mike below on finding no difference in timing when using a call.
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[a]]
]
gives
{0.031, True}
But that is because a is now the number 1000 INSIDE the function, once it is called. Since M passes things by VALUE.
If we force the call to be by reference, so that a is left unevaluated, then we get
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[Unevaluated#a]]
]
now we see the expected result, since now a is still symbolic INSIDE the function, we are back to square one, and now it is slow, since not packed. And since it is not packed, Compile is not used.
{0.437, False}
edit(2)
Thanks to everyone for the answers, I think I learned allot from them.
Here is an executive summary, just to make sure I got everything ok.
edit(3)
Here are links I have specially related to hints to use to making Mathematica code runs faster.
http://library.wolfram.com/howtos/faster/
http://blog.wolfram.com/2011/12/07/10-tips-for-writing-fast-mathematica-code/
https://stackoverflow.com/questions/4721171/performance-tuning-in-mathematica
Using Array and Table Functions in Mathematica. Which is best when
So this is what I think is happening. The reason why you see the slow down between a numeric and a symbolic limit on Table is due to the fact that you do a double index. Each sub-table (e.g. going over all indices j for a fixed index i) is constructed separately and when the limit is symbolic there is an extra step involved in figuring out that limit before constructing each sub table. You can see this by examining, e.g.
Trace[a = 3;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
David gives a good example for why you would want to do this check for every sub list. As to why Mathematica cannot figure out when this check is not needed I have no clue. If you only have one index to sum over there is no difference in speed between the symbolic and numeric version
Timing[tbl = Table[i + j, {j, 1, 1000}];]
{0.0012, Null}
Timing[a = 1000;
tbl = Table[i + j, {j, 1, a}];
]
{0.0013, Null}
To answer your follow up regarding speed; making tbl a function is faster for both numeric and symbolic limits.
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
tblFunc[a];
]
{0.045171, Null}
vs.
Timing[tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];]
{0.066864, Null}
Timing[a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
{0.632128, Null}
You gain even more speed if you intend to reuse the tbl construction.
b=1000;
Timing[tblFunc[b];]
{0.000013, Null}
The key things to monitor, as others have mentioned, are packing and list length. I actually don't see the differences that Timo reports:
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[a]]]
{0.077706, True}
vs
ClearAll[tbl];
Timing[
tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];
Developer`PackedArrayQ[tbl]]
{0.076661, True}
ClearAll[tbl];
Timing[a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tbl]]
{1.02879, False}
So for me the only difference is if the list is packed. Whether it is a function makes no difference to timing on my set up. And as expected when you switch off autocompilation the timings are the same for all of the above because no packing occurs:
SetSystemOptions["CompileOptions" -> {"TableCompileLength" -> Infinity}];
{1.05084, False}
vs
{1.00348, False}
{1.01537, False}
reset the table autocompile length:
SetSystemOptions["CompileOptions" -> {"TableCompileLength" -> 250}]
This is slightly OT, but for speed here you might want to avoid using the item-by-item processing that's implicit in using Table. Rather, use Outer. Here's what I'm seeing on my system:
Timing[Outer[Plus, Range[5000], Range[5000]];]
{0.066763,Null}
Timing[Table[i + j, {i, 1, 5000}, {j, 1, 5000}];]
{0.555197,Null}
Quite a dramatic difference.

Mathematica: How to obtain data points plotted by plot command?

When plotting a function using Plot, I would like to obtain the set of data points plotted by the Plot command.
For instance, how can I obtain the list of points {t,f} Plot uses in the following simple example?
f = Sin[t]
Plot[f, {t, 0, 10}]
I tried using a method of appending values to a list, shown on page 4 of Numerical1.ps (Numerical Computation in Mathematica) by Jerry B. Keiper, http://library.wolfram.com/infocenter/Conferences/4687/ as follows:
f = Sin[t]
flist={}
Plot[f, {t, 0, 10}, AppendTo[flist,{t,f[t]}]]
but generate error messages no matter what I try.
Any suggestions would be greatly appreciated.
f = Sin[t];
plot = Plot[f, {t, 0, 10}]
One way to extract points is as follows:
points = Cases[
Cases[InputForm[plot], Line[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity];
ListPlot to 'take a look'
ListPlot[points]
giving the following:
EDIT
Brett Champion has pointed out that InputForm is superfluous.
ListPlot#Cases[
Cases[plot, Line[___], Infinity], {_?NumericQ, _?NumericQ},
Infinity]
will work.
It is also possible to paste in the plot graphic, and this is sometimes useful. If,say, I create a ListPlot of external data and then mislay the data file (so that I only have access to the generated graphic), I may regenerate the data by selecting the graphic cell bracket,copy and paste:
ListPlot#Transpose[{Range[10], 4 Range[10]}]
points = Cases[
Cases[** Paste_Grphic _Here **, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Edit 2.
I should also have cross-referenced and acknowledged this very nice answer by Yaroslav Bulatov.
Edit 3
Brett Champion has not only pointed out that FullForm is superfluous, but that in cases where a GraphicsComplex is generated, applying Normal will convert the complex into primitives. This can be very useful.
For example:
lp = ListPlot[Transpose[{Range[10], Range[10]}],
Filling -> Bottom]; Cases[
Cases[Normal#lp, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
gives (correctly)
{{1., 1.}, {2., 2.}, {3., 3.}, {4., 4.}, {5., 5.}, {6., 6.}, {7.,
7.}, {8., 8.}, {9., 9.}, {10., 10.}}
Thanks to Brett Champion.
Finally, a neater way of using the general approach given in this answer, which I found here
The OP problem, in terms of a ListPlot, may be obtained as follows:
ListPlot#Cases[g, x_Line :> First#x, Infinity]
Edit 4
Even simpler
ListPlot#Cases[plot, Line[{x__}] -> x, Infinity]
or
ListPlot#Cases[** Paste_Grphic _Here **, Line[{x__}] -> x, Infinity]
or
ListPlot#plot[[1, 1, 3, 2, 1]]
This evaluates to True
plot[[1, 1, 3, 2, 1]] == Cases[plot, Line[{x__}] -> x, Infinity]
One way is to use EvaluationMonitor option with Reap and Sow, for example
In[4]:=
(points = Reap[Plot[Sin[x],{x,0,4Pi},EvaluationMonitor:>Sow[{x,Sin[x]}]]][[2,1]])//Short
Out[4]//Short= {{2.56457*10^-7,2.56457*10^-7},<<699>>,{12.5621,-<<21>>}}
In addition to the methods mentioned in Leonid's answer and my follow-up comment, to track plotting progress of slow functions in real time to see what's happening you could do the following (using the example of this recent question):
(* CPU intensive function *)
LogNormalStableCDF[{alpha_, beta_, gamma_, sigma_, delta_}, x_] :=
Block[{u},
NExpectation[
CDF[StableDistribution[alpha, beta, gamma, sigma], (x - delta)/u],
u \[Distributed] LogNormalDistribution[Log[gamma], sigma]]]
(* real time tracking of plot process *)
res = {};
ListLinePlot[res // Sort, Mesh -> All] // Dynamic
Plot[(AppendTo[res, {x, #}]; #) &#
LogNormalStableCDF[{1.5, 1, 1, 0.5, 1}, x], {x, -4, 6},
PlotRange -> All, PlotPoints -> 10, MaxRecursion -> 4]
etc.
Here is a very efficient way to get all the data points:
{plot, {points}} = Reap # Plot[Last#Sow#{x, Sin[x]}, {x, 0, 4 Pi}]
Based on the answer of Sjoerd C. de Vries, I've now written the following code which automates a plot preview (tested on Mathematica 8):
pairs[x_, y_List]:={x, #}& /# y
pairs[x_, y_]:={x, y}
condtranspose[x:{{_List ..}..}]:=Transpose # x
condtranspose[x_]:=x
Protect[SaveData]
MonitorPlot[f_, range_, options: OptionsPattern[]]:=
Module[{data={}, plot},
Module[{tmp=#},
If[FilterRules[{options},SaveData]!={},
ReleaseHold[Hold[SaveData=condtranspose[data]]/.FilterRules[{options},SaveData]];tmp]]&#
Monitor[Plot[(data=Union[data, {pairs[range[[1]], #]}]; #)& # f, range,
Evaluate[FilterRules[{options}, Options[Plot]]]],
plot=ListLinePlot[condtranspose[data], Mesh->All,
FilterRules[{options}, Options[ListLinePlot]]];
Show[plot, Module[{yrange=Options[plot, PlotRange][[1,2,2]]},
Graphics[Line[{{range[[1]], yrange[[1]]}, {range[[1]], yrange[[2]]}}]]]]]]
SetAttributes[MonitorPlot, HoldAll]
In addition to showing the progress of the plot, it also marks the x position where it currently calculates.
The main problem is that for multiple plots, Mathematica applies the same plot style for all curves in the final plot (interestingly, it doesn't on the temporary plots).
To get the data produced into the variable dest, use the option SaveData:>dest
Just another way, possibly implementation dependent:
ListPlot#Flatten[
Plot[Tan#t, {t, 0, 10}] /. Graphics[{{___, {_, y__}}}, ___] -> {y} /. Line -> List
, 2]
Just look into structure of plot (for different type of plots there would be a little bit different structure) and use something like that:
plt = Plot[Sin[x], {x, 0, 1}];
lstpoint = plt[[1, 1, 3, 2, 1]];

Getting a number of arrays from an array list

Hi I am using Mathematica 5.2. Suppose I have an array list like
In[2]:=lst=Tuples[{0,1},4]
Out[2]={{0,0,0,0},{0,0,0,1},{0,0,1,0},{0,0,1,1},
{0,1,0,0},{0,1,0,1},{0,1,1,0},{0,1,1,1},
{1,0,0,0},{1,0,0,1},{1,0,1,0},{1,0,1,1},
{1,1,0,0},{1,1,0,1},{1,1,1,0},{1,1,1,1}}
Now I want to get 16 arrays from the above array like st1={0,0,0,0}; st2={0,0,0,1}, st3={0,0,1,0}...
How can I get these array lists using a loop. Because if the no. of elements of the above array named lst become larger then it will not be a wise decision to take each of the element of the array lst separately and give their name separately. I tried this like the following way but it is not working...
Do[st[i]=lst[[i]],{i,1,16}]
Plz some body help me in this problem...
It does work, but what you create are the so-called indexed variables. You should access them also using the index, for example:
In[4]:= {st[1], st[2], st[3]}
Out[4]= {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}}
I think what you are trying to do could be done by:
lst = Tuples[{0, 1}, 4];
Table[Evaluate[Symbol["lst" <> ToString[i]]] = lst[[i]], {i, Length#lst}]
So that
lst1 == {0,0,0,0}
But this is not a useful way to manage vars in Mathematica.
Edit
I'll try to show you why having vars lst1,lst2 .. is not useful, and is against the "Mathematica way".
Mathematica works better by applying functions to objects. For example, suppose you want to work with EuclideanDistance. You have a point {1,2,3,4} in R4, and you want to calculate the nearest point from your set to this point.
This is easily done by
eds = EuclideanDistance[{1, 2, 3, 4}, #] & /# Tuples[{0, 1}, 4]
And the nearest point distance is simply:
min = Min[eds]
If you want to know which point/s are the nearest ones, you can do:
Select[lst, EuclideanDistance[{1, 2, 3, 4}, #] == min &]
Now, try to do that same things with your intended lst1,lst2 .. asignments, and you will find it, although not impossible, very,very convoluted.
Edit
BTW, once you have
lst = Tuples[{0, 1}, 4];
You can access each element of the list just by typing
lst[[1]]
etc. In case you need to loop. But again, loops are NOT the Mathematica way. For example, if you want to get another list, with your elements normalized, don't loop and just do:
lstNorm = Norm /# lst
Which is cleaner and quicker than
Do[st[i] = Norm#lst[[i]], {i, 1, 16}]
You will find that defining downvalues (like st[i]) above) is useful when solving equations, but besides that many operations that in other languages are done using arrays, in Mathematica are better carried out by using lists.
Edit
Answering your comment actually I need each element of array lst to find the value of function such as f[x,y,z,k]=x-y+z+k. Such function may be
(#1 - #2 + #3 + #4) & ### lst
or
(#[[1]] - #[[2]] + #[[3]] + #[[4]]) & /# lst
Out:
{0, 1, 1, 2, -1, 0, 0, 1, 1, 2, 2, 3, 0, 1, 1, 2}
HTH!
You can do this:
Table[
Evaluate[
Symbol["st" <> ToString#i]] = lst[[i]],
{i, 1, Length#lst}];
at the end of which try Names["st*"] to see that you now have st1 to st16 defined. You could also do this with MapIndexed, like so:
MapIndexed[(Evaluate#Symbol["sts" <> ToString~Apply~#2] = #1) &, lst]
after which Names["sts*"] shows again that it has worked. Both of these can be done using a loop if this is what you (but I do not see what it buys you).
On the other hand, this way, when you want to access one of them, you need to do something like Symbol["sts" <> ToString[4]]. Using what you have already done or something equivalent, eg,
Table[
Evaluate[stg[i]] = lst[[i]],{i, 1, Length#lst}]
you end up with stg[1], stg[2] etc, and you can access them much more easily by eg Table[stg[i],{i,1,Length#lst}]
You can see what has been defined by ?stg or in more detail by DownValues[stg].
Or is it something else you want?
Leonid linked to a tutorial, which I suggest you read, by the way.
There are N ways of doing this, though like belisarius I have my doubts about your approach. Nonetheless, the easiest way I've found to manage things like this is to use what Mathematica calls "pure functions", like so:
In[1]:= lst = Tuples[{0,1}, 4];
In[2]:= With[{setter = (st[#1] = #2) &},
Do[setter[i, lst[[i]]], {i, Length#lst}]];
Doing it this way, the evaluation rules for special do just what you want. However, I'd approach this without a loop at all, just using a single definition:
In[3]:= ClearAll[st] (* Clearing the existing definitions is important! *)
In[4]:= st[i_Integer] := lst[[i]]
I think if you provide more detail about what you're trying to accomplish, we'll be able to provide more useful advice.
EDIT: Leonid Shifrin comments that if you change the definition of lst after the fact, the change will also affect st. You can avoid this by using With in the way he describes:
With[{rhs = lst},
st[i_Integer] := rhs[[i]]];
I don't know which will be more useful given what you're trying to do, but it's an important point either way.
Maybe something like this?
MapThread[Set, {Array[st, Length#lst], lst}];
For example:
{st[1], st[10], st[16]}
Out[14]= {{0, 0, 0, 0}, {1, 0, 0, 1}, {1, 1, 1, 1}}

Resources