MiniMaxApproximation not working in Mathematica 7 - wolfram-mathematica

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}]

Related

in mathematica how to get fully expanded answer for rational system of linear equations

I define a matrix.
m= { {2, 1, 1}, {1, 2, 0}}
Then i solve the system of linear equation.
It gives correct result. But same thing if i do using non-integral coefficients such as re-defining m as
m = {{2, 1, 1}, {1, 1/N[Sqrt[3], 3], 0}}
It fails. How to resolve this issue?

Use Manipulate function in Mathematica to fit function to data

I want to use the Manipulate function in Mathematica to fit an analytical function to a set of (x,y) data. I want to plot the dataset on the same axes that I use to manipulate the function (so I can get a visual check of how manipulating the parameters improves the fit, but I cannot find the correct syntax to draw the points behind the manipulated curve. Any solutions to this? Many thanks!
Show[plot1,plot2,...] will overlay the plots, see the docs on Show.
In[1]:= data = Table[{x, x^2+2*x+RandomReal[{-.1,.1}]}, {x,-3,3}];
Manipulate[
Show[ListPlot[data], Plot[a*x^2 + b*x + c, {x, -3, 3}]],
{{a, 0}, -4, 4}, {{b, 0}, -4, 4}, {{c, 2}, -4, 4}]
Out[1]= ...PlotSnipped...

how to build a list on the fly with condition, the functional way

I am still not good working with lists in Mathematica the functional way. Here is a small problem that I'd like to ask what is a good functional way to solve.
I have say the following list made up of points. Hence each element is coordinates (x,y) of one point.
a = {{1, 2}, {3, 4}, {5, 6}}
I'd like to traverse this list, and every time I find a point whose y-coordinate is say > 3.5, I want to generate a complex conjugate point of it. At the end, I want to return a list of the points generated. So, in the above example, there are 2 points which will meet this condition. Hence the final list will have 5 points in it, the 3 original ones, and 2 complex conjugtes ones.
I tried this:
If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, #] & /# a
but I get this
{{1, 2}, {{3, 4}, {3, -4}}, {{5, 6}, {5, -6}}}
You see the extra {} in the middle, around the points where I had to add a complex conjugate point. I'd like the result to be like this:
{{1, 2}, {3, 4}, {3, -4}, {5, 6}, {5, -6}}
I tried inserting Flatten, but did not work, So, I find myself sometimes going back to my old procedural way, and using things like Table and Do loop like this:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
If[a[[i, 2]] > 3.5,
{
AppendTo[result, a[[i]]]; AppendTo[result, {a[[i, 1]], -a[[i, 2]]}]
},
AppendTo[result, a[[i]]]
],
{i, 1, Length[a]}
]
Which gives me what I want, but not functional solution, and I do not like it.
What would be the best functional way to solve such a list operation?
update 1
Using the same data above, let assume I want to make a calculation per each point as I traverse the list, and use this calculation in building the list. Let assume I want to find the Norm of the point (position vector), and use that to build a list, whose each element will now be {norm, point}. And follow the same logic as above. Hence, the only difference is that I am making an extra calculation at each step.
This is what I did using the solution provided:
a = {{1, 2}, {3, 4}, {5, 6}}
If[#[[2]] > 3.5,
Unevaluated#Sequence[ {Norm[#], #}, {Norm[#], {#[[1]], -#[[2]]}}],
{Norm[#], #}
] & /# a
Which gives what I want:
{ {Sqrt[5],{1,2}}, {5,{3,4}}, {5,{3,-4}}, {Sqrt[61],{5,6}}, {Sqrt[61],{5,-6}} }
The only issue I have with this, is that I am duplicating the call to Norm[#] for the same point in 3 places. Is there a way to do this without this duplication of computation?
This is how I currently do the above, again, using my old procedural way:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
o = Norm[a[[i]]];
If[a[[i, 2]] > 3.5,
{
AppendTo[result, {o, a[[i]]}]; AppendTo[result, {o, {a[[i, 1]], -a[[i, 2]]}}]
},
AppendTo[result, {o, a[[i]]}]
],
{i, 1, Length[a]}
]
And I get the same result as the functional way, but in the above, since I used a temporary variable, I am doing the calculation one time per point.
Is this a place for things like sow and reap? I really never understood well these 2 functions. If not, how would you do this in functional way?
thanks
One way is to use Sequence.
Just a minor modification to your solution:
If[#1[[2]] > 3.5, Unevaluated#Sequence[#1, {#1[[1]], -#1[[2]]}], #1] & /# a
However, a plain ReplaceAll might be simpler:
a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
This type of usage is the precise reason Rule and RuleDelayed have attribute SequenceHold.
Answer to update 1
I'd do it in two steps:
b = a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
{Norm[#], #}& /# b
In a real calculation there's a chance you'd want to use the norm separately, so a Norm /# b might do
While Mathematica can simulate functional programming paradigms quite well, you might consider using Mathematica's native paradigm -- pattern matching:
a = {{1,2},{3,4},{5,6}}
b = a /. p:{x_, y_ /; y > 3.5} :> Sequence[p, {x, -y}]
You can then further transform the result to include the Norms:
c = Cases[b, p_ :> {Norm#p, p}]
There is no doubt that using Sequence to generate a very large list is not as efficient as, say, pre-allocating an array of the correct size and then updating it using element assignments. However, I usually prefer clarity of expression over such micro-optimization unless said optimization is measured to be crucial to my application.
Flatten takens a second argument that specifies the depth to which to flatten. Thus, you could also do the following.
a = {{1, 2}, {3, 4}, {5, 6}};
Flatten[If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}] & /# a, 1]
The most serious problem with your Do loop is the use of AppendTo. This will be very slow if result grows long. The standard way to deal with lists that grow as the result of a procedure like this is to use Reap and Sow. In this example, you can do something like so.
new = Reap[
Do[If[el[[2]] > 3.5, Sow[{el[[1]], -el[[2]]}]],
{el, a}]][[2, 1]];
Join[a, new]
To answer your edit, use With (or Module) if you're going to use something expensive more than once.
Here's my version of the problem in your edit:
a = {{1, 2}, {3, 4}, {5, 6}};
Table[With[{n = Norm[x]},
Unevaluated#Sequence[{n, x},
If[x[[2]] > 3.5, {n, {1, -1} x}, Unevaluated#Sequence[]]]],
{x, a}]
The structure of the above could be modified for use in a Map or ReplaceAll version, but I think that Table is clearer in this case. The unevaluated sequences are a little annoying. You could instead use some undefined function f then replace f with Sequence at the end.
Mark's Sow/Reap code does not return the elements in the order requested. This does:
a = {{1, 2}, {3, 4}, {5, 6}};
Reap[
If[Sow[#][[2]] > 3.5, Sow[# {1, -1}]] & /# a;
][[2, 1]]
You may use join with Apply(##):
Join ## ((If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}]) & /# a)

problem with using some Functions with LocatorPane Dynamic point

I can't figure out why Mathematica behaves this way, may be someone can see the problem. I am no expert on Dynamics, so I might be overlooking something.
I show the code first and then say what the problem is.
Clear[t, s, n, z];
Grid[{
{LocatorPane[Dynamic[p], Graphics[Circle[{0, 0}, 1], ImageSize -> 200],{{-1, -1}, {1, 1}}]},
{Dynamic[{Print#Date[]; Print[ZTransform[n^2/2^n, n, z]]; p}]}}
]
When running the above, you will see that it keeps looping all the time, since it keeps printing. You will see the print messages come out without doing anything to the LocatorPane or moving the mouse.
But when I changed the function above which is ZTransform, to something else, say Laplace, then the looping stops:
Clear[t, s, n, z];
Grid[{
{LocatorPane[Dynamic[p], Graphics[Circle[{0, 0}, 1], ImageSize -> 200],{{-1, -1}, {1, 1}}]},
{Dynamic[{Print#Date[]; Print[LaplaceTransform[t^4*Sin[t], t, s]]; p}]}}
]
It seems functions related Fourier causes this, since I tried this one also and it had the same problem:
Clear[t, s, n, z,w];
Grid[{
{LocatorPane[Dynamic[p], Graphics[Circle[{0, 0}, 1], ImageSize -> 200],{{-1, -1}, {1, 1}}]},
{Dynamic[{Print#Date[]; Print[FourierSequenceTransform[(1/2)^n UnitStep[n], n, w]]; p}]}}
]
Another way of doing the above is using a Module:
process[p_] := Module[{n, z, t, s, w},
Print[Date[]];
ZTransform[n^2 2^(-n), n, z];
p
]
Grid[{
{LocatorPane[Dynamic[p],
Graphics[Circle[{0, 0}, 1],ImageSize -> 200], {{-1, -1}, {1, 1}}]},
{Dynamic[process[p]]}
}]
And again, same problem, I see the looping again. I have to wrap the call to process[p] above with Dynamics to pass the current value of 'p'.
So, my question is why when I use some functions such as ZTransform, Dynamics continue to update, but some other functions such as Laplace, I do not see this problem.
And what can I do to fix this? I do need to call ZTransform using the updated point 'p' in this example.
This is on version 8.01 on windows.
thanks
EDIT1:
I found something which might help. When I add FinishDynamic[] after the call to ZTransform[], it blocks. But not with another call such as Laplace. This means, according to documenation, that ZTransform generates a Dynamic which has not finished updating. What object is this?
Here is an example:
process[p_] := Module[{n, z},
Print[Date[]];
ZTransform[n^2 2^(-n), n, z]; (*bad*)
FinishDynamic[]; (*BLOCKS*)
p
]
Grid[{
{LocatorPane[Dynamic[p],
Graphics[Circle[{0, 0}, 1],
ImageSize -> 200], {{-1, -1}, {1, 1}}]},
{Dynamic[process[p]]}
}]
Again, changing ZTransform[] to some other call, say Laplace[] does not have this problem.
So, it seems to me that ZTransform[] is generating some Dynamic which never finish updating or something along these lines?
EDIT2:
I found the solution. Add trackedSymbols. Here it is
process[p_] := Module[{n, z},
Print[Date[]];
ZTransform[n^2 2^(-n), n, z];(*bad*)
p]
Grid[{
{LocatorPane[Dynamic[p], Graphics[Circle[{0, 0}, 1],ImageSize -> 200], {{-1, -1}, {1, 1}}]},
{Dynamic[process[p], TrackedSymbols :> {p}]
}
}]
Not sure why it is needed when calling ZTransform and not needed with other functions. My guess is this: ZTransform generated a dynamic internally that never finished 'updating' (that is why it blocked as per EDIT1 above).
By explicitly adding TrackedSymbols only on the LocatorPane variable 'p', it now works since whatever other dynamic was causing the problem inside ZTrasnform is not tracked now.
Have you tried turning off SynchronousUpdating? (see documentation)
I am not entirely sure why some functions are doing this and not others, but it might be that the particular kind of transform you are doing doesn't finish evaluating before the Dynamic tries to update. If so, another thing to try would be to change the value of the SynchronousInitialization option to False (default is True). Then the transform is queued even while the Dynamic or Manipulate construct is updating, instead of (according to the documentation), waiting until the evaluation of the initialization expression is complete before proceeding.

Using the solution of a differential equation in two separate plot commands in Mathematica

I've encountered a problem while trying to use the answer from a NDSolve in two separate plot commands. To illustrate the problem, I'll use a simple differential equation and only one plot command. If I write something like this:
{Plot[x[t], {t, 0, 10}], x[4]}
/. NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}]
It solves the equation and calculates x[4] with no problem, but the plot turns empty, and I have no idea why.
In my actual problem, my equation is a quite complicated system for several functions, and instead of x[4] I draw a parametric plot of the solved functions. I ultimately intend to include all this in a Manipulate statement so I don't want the NDSolve statement to appear more than once (takes too long) and I can't just calculate it in advance (since it has a lot of parameters).
Edit: I would like to clarify and expand my question: What I actually want to do is to include my plotting statement in a Manipulate statement in the following way:
Manipulate[{Plot[x[t], {t, 0, 10}], x[4]}
/. NDSolve[{x'[s] == - a*x[s], x[0] == 1}, x, {s, 0, 10}]
,{{a,1},0,5}]
Since only the Manipulate statement gives value to the parameter a, I can't calculate the answer to the NDSolve beforehand. Also, since my actual equation system is very complicated and non-linear, I can't use the symbolic function DSolve.
Sorry if it wasn't clear before.
Your problem is that Plot[] does some funny things to make plotting more convenient, and one of the things it does is just not plot things it can't evaluate numerically. So in the expression you posted,
Plot[x[t], {t, 0, 10}]
just goes ahead and evaluates before doing the rule substitution with the solution from NDSolve, producing a graphics object of an empty plot. That graphics object contains no reference to x, so there's nothing to substitute for.
You want to make sure the substitution is done before the plotting. If you also want to make sure the substitution can be done in multiple places, you want to store the solution into a variable.
sol = NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}];
{Plot[Evaluate[x[t] /. sol], {t, 0, 10}], x[4] /. sol}
The Evaluate[] in the Plot makes sure that Mathematica only does the substitution once, instead of once for each plot point. It's not important for a simple rule substitution like this, but it's a good habit to use it in case you ever want to plot something more complicated.
In order to make this work in a Manipulate, the simple way is to use With[], which is one of Mathematica's scoping constructs; it's the one to use where you just want to substitute something in without using it as variable you can mutate.
For example,
Manipulate[
With[{sol = NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}]},
{Plot[x[t] /. sol // Evaluate, {t, 0, 10}, PlotRange -> {0, 1}],
x[4] /. sol}],
{{a, 1}, {0, 5}}]
Use the PlotRange option to keep the y-axis fixed; otherwise things will jump around in an ugly way as the value of a changes. When you do more complex things with Manipulate, there are a number of options for controlling the speed of updates, which can be important if your ODE is complicated enough that it takes a while to solve.
Meanwhile, I found another way to do this. It's less elegant, but it only uses one substitution so I've thought I'll post it here also.
The idea is to use Hold on the Plot so it wouldn't get evaluated, do the rule substitution and then ReleaseHold, just before the Manipulate.
Manipulate[ReleaseHold[
Hold[ {Plot[x[t], {t, 0, 10}, PlotRange -> {0, 1}], x[4]} ]
/.NDSolve[{x'[s] == -a x[s], x[0] == 1}, x, {s, 0, 10}]
], {{a, 1}, 0, 5}]

Resources