Increasing Mathematica FunctionInterpolation Accuracy/Domain - wolfram-mathematica

My current problem is trying to use FunctionInterpolation[] on complicated functions, the easiest to see this is probably when you compare the difference between:
FunctionInterpolation[Sin[t], {t, 0, 30}]
Plot[%[t], {t, 0, 30}]
and
FunctionInterpolation[Sin[t], {t, 0, 1000}]
Plot[%[t], {t, 0, 30}]
By increasing the domain of the function the interpolation becomes very inaccurate, I'm looking for a way to create a FunctionInterpolation[] that has an arbitrarily high accuracy for an arbitrarily long domain. It appears to be possible for short domains but I have been unable so far to find a solution for both.
If this is not possible, why not? is there something special about the form of InterpolationFunction that I'm unaware of?

You can try to include derivatives as well :
FunctionInterpolation[{Sin[t], Cos[t], -Sin[t], -Cos[t]}, {t, 0, 1000}]
Plot[%[t], {t, 0, 100}]

You can apparently increase the underlying sampling frequency by using an undocumented syntax for the function range:
FunctionInterpolation[Sin[t], {t, 0, 1000, 20}]
Plot[%[t], {t, 0, 30}]

Try the undocumented option InterpolationOrder->n with a large n like, say 50:
With[{func = FunctionInterpolation[Sin[t], {t, 0, 1000}]},
Plot[func[x], {x, 150, 160}]
]
With[{func = FunctionInterpolation[Sin[t], {t, 0, 1000}, InterpolationOrder -> 50]},
Plot[func[x], {x, 150, 160}]
]
You can also try the undocumented InterpolationPoints:
With[{func = FunctionInterpolation[Sin[t], {t, 0, 1000}, InterpolationPoints -> 50]},
Plot[func[x], {x, 150, 160}]
]

Related

Problem with using Manipulate in Mathematica

I tried the following example, but nothing shows up.
f = a*b*c*x
Manipulate[Plot[f, {x, 0, 1}], {a, 0, 1}, {b, 0, 1}, {c, 0, 1}]
However, if I replace f in the second line by a*b*c*x directly, it works. Could anyone explain why this happens, please?
(In fact, my f could be obtained by some tedious calculation and it is a long expression, so it is inappropriate to copy-paste it into the second line.)
Thanks for Bill's detailed explanation. I think of a way to work around this with his suggestion.
g = a*b*c*x;
f[a_, b_, c_, x_] := Evaluate[g];
Manipulate[ Plot[Evaluate[g], {x, 0, 1}], {a, 0, 1}, {b, 0, 1}, {c, 0, 1}]

Draw a square wave using Mathematica for a long range

I want to get a continuous square wave use the software mathematica.
Plot[SquareWave[{0, 10}, x], {x, 0, 10},
ExclusionsStyle -> Directive[Dotted, Red]]
However, if I set the xmax to be 100,the picture will be out of expectation.
Plot[SquareWave[{0, 10}, x], {x, 0, 100},
ExclusionsStyle -> Directive[Dotted, Red]]
Here is the result:
(http://i.stack.imgur.com/NfWVK.png)
What about another way to generate a square wave? I didn't remember where I saw,but I know we can use UnitStep.
However, it still exists the problem out of expectation.
Plot[10 UnitStep[-Sin[0.4 Pi t]], {t, 0, 200}, Exclusions -> None,
PlotStyle -> Thick]
Plot[10 UnitStep[-Sin[0.4 Pi t]], {t, 0, 500}, Exclusions -> None,
PlotStyle -> Thick]
(http://i.stack.imgur.com/iPRLc.png)
Actually,the square wave generate is used as the clock signal, so I hope it stable, continuous.
Hope you could help me to slove this problem. Hear from you soon.
There is nothing wrong with SquareWave. The trouble is Plot does a fairly coarse initial sampling and doesn't detect all the discrete regions. You simply need to give Plot a PlotPoints specification:
Plot[SquareWave[{0, 10}, x], {x, 0, 100}, PlotPoints -> 1000,
ExclusionsStyle -> Directive[Dotted, Red]]
PlotPoints needs to be set large enough so that the initial sampling hits every interval.
Alternately you can explicitly provide the points to plot and use ListLinePlot
ListLinePlot[
Flatten[Table[
{{i,10},{i+1,10},{i+1,0},{i+2,0}} ,
{i, 0, 100, 2}], 1]]
I don't see straight away how to apply the dashing in this case though.

How does this deviation come out after I use Evaluate and Plot in Mathematica?

I ran into this problem when I try to solve a partial differential equation. Here is my code:
dd = NDSolve[{D[tes[t, x], t] ==D[tes[t, x], x, x] + Exp[-1/(tes[t, x])],
tes[t, 0] == 1, tes[t, -1] == 1, tes[0, x] == 1}, {tes[t, x]}, {t, 0, 5}, {x, -1, 0}]
f[t_, x_] = tes[t, x] /. dd
kkk = FunctionInterpolation[Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}], {t, 0, 0.05}]
kkg[t_] = Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}]
Plot[Evaluate[kkk[t]] - Evaluate[kkg[t]], {t, 0, 0.05}]
N[kkg[0.01] - kkk[0.01], 1]
It's strange that the deviation showed in the graph reaches up to more than 5*10^-7 around t=0.01, while it's only -3.88578*10^-16 when calculated by N[kkg[0.01] - kkk[0.01], 1], I wonder how this error comes out.
By the way, I feel it strange that the output of N[kkg[0.01] - kkk[0.01], 1] has so many decimal places, I've set the precision as 1, right?
Using Mathematica 7 the plot I get does not show a peak at 0.01:
Plot[kkk[t] - kkg[t], {t, 0, 0.05}, GridLines -> Automatic]
There is a peak at about 0.00754:
kkk[0.00754] - kkg[0.00754] // N
{6.50604*10^-7}
Regarding N, it does not change the precision of machine precision numbers as it does for exact or arbitrary precision ones:
N[{1.23456789, Pi, 1.23456789`50}, 2]
Precision /# %
{1.23457, 3.1, 1.2}
{MachinePrecision, 2., 2.}
Look at SetPrecision if you want to force (fake) a precision, and NumberForm if you want to print a number in a specific format.

mathematica Plot with Manipulate shows no output

I was initially attempting visualize a 4 parameter function with Plot3D and Manipulate sliders (with two params controlled by sliders and the other vary in the "x-y" plane). However, I'm not getting any output when my non-plotted parameters are Manipulate controlled?
The following 1d plot example replicates what I'm seeing in the more complex plot attempt:
Clear[g, mu]
g[ x_] = (x Sin[mu])^2
Manipulate[ Plot[ g[x], {x, -10, 10}], {{mu, 1}, 0, 2 \[Pi]}]
Plot[ g[x] /. mu -> 1, {x, -10, 10}]
The Plot with a fixed value of mu has the expected parabolic output in the {0,70} automatically selected plotrange, whereas the Manipulate plot is blank in the {0, 1} range.
I was suspecting that the PlotRange wasn't selected with good defaults when the mu slider control was used, but adding in a PlotRange manually also shows no output:
Manipulate[ Plot[ g[x], {x, -10, 10}, PlotRange -> {0, 70}], {{mu, 1}, 0, 2 \[Pi]}]
This is because the Manipulate parameters are local.
The mu in Manipulate[ Plot[ g[x], {x, -10, 10}], {{mu, 1}, 0, 2 \[Pi]}] is different from the global mu you clear on the previous line.
I suggest using
g[x_, mu_] := (x Sin[mu])^2
Manipulate[Plot[g[x, mu], {x, -10, 10}], {{mu, 1}, 0, 2 \[Pi]}]
The following works too, but it keeps changing the value of a global variable, which may cause surprises later unless you pay attention, so I don't recommend it:
g[x_] := (x Sin[mu])^2
Manipulate[
mu = mu2;
Plot[g[x], {x, -10, 10}],
{{mu2, 1}, 0, 2 \[Pi]}
]
It may happen that you Clear[mu], but find that it gets a value the moment the Manipulate object is scrolled into view.
Another way to overcome Manipulate's localization is to bring the function inside the Manipulate[]:
Manipulate[Module[{x,g},
g[x_]=(x Sin[mu])^2;
Plot[g[x], {x, -10, 10}]], {{mu, 1}, 0, 2 \[Pi]}]
or even
Manipulate[Module[{x,g},
g=(x Sin[mu])^2;
Plot[g, {x, -10, 10}]], {{mu, 1}, 0, 2 \[Pi]}]
Both of which give
Module[{x,g},...] prevents unwanted side-effects from the global context. This enables a simple definition of g: I've had Manipulate[]ed plots with dozens of adjustable parameters, which can be cumbersome when passing all those parameters as arguments to the function.

How to define part of a Manipulate control variable definition to reduce code duplication

This is a little related to this question
Define control as variable in Mathematica
But the above question did not answer my problem, as it talks about the full control definition. (I also tried some of the tricks shown there, but they do not work for my problem).
I am now asking about definition for only part of the control. (It is also very hard to follow up on an old question using this forum format. Because using the tiny comment area, it hard to ask and show more like when asking a new question where the space is larger, and one can paste code and images).
All the tries I have made do not work. I'll start by simple example to explain the problem.
Assume one want to write
Clear["Global`*"];
Manipulate[Plot[f*g, {x, -1, 1}],
Grid[{
{Style["f(x)="],
PopupMenu[Dynamic[f], {x, x^2, x^3}, ImageSize -> Tiny]},{Style["g(x)="],
PopupMenu[Dynamic[g], {x, x^2, x^3}, ImageSize -> Tiny]}
}]
]
you can see there is allot of code duplication in each control definition. (things like ImageSize, Spacings-> and many other decoration settings, are repeated over and over for each control.
What will be great, if I can write something like
Manipulate[Plot[f*g, {x, -1, 1}],
Grid[{
{Style["f(x)="], PopupMenu[Dynamic[f], Evaluate#Sequence#v]},
{Style["g(x)="], PopupMenu[Dynamic[g], Evaluate#Sequence#v]}
}],
Initialization :>
(
v = {{x, x^2, x^3}, ImageSize -> Tiny}
)
]
But this does not work. I tries many other things along the above line, and nothing works. Like
{Style["f(x)="], PopupMenu[Dynamic[f], v]},
and
{Style["f(x)="], PopupMenu[Dynamic[f], Evaluate#v]}
and
Manipulate[Plot[f*g, {x, -1, 1}],
{{v, {{x, x^2, x^3}, ImageSize -> Tiny}}, None},
Grid[{
{Style["f(x)="], PopupMenu[Dynamic[f], Evaluate#v]},
{Style["g(x)="], PopupMenu[Dynamic[g], v]}
}]
]
can't get it to work.
But here are the rules of the game: This will be for a demo, hence, code must start with Manipulate. Can't have Module outside Manipulate. Also, can not use Hold and its friends. But can use Unevaluated.
I was hoping the experts here might have a trick to do this. The will reduce the code size if it is possible to do, as many of the control I have, contain many 'options' like the above that are the same, and being able to do the above will make the code easier to read and manage.
thanks,
ps. What I am asking for, is sort of similar to what one does for say Plot options, where one can use SetOptions to set some common default options so they do not have to duplicate them for each Plot command each time. But there is no such thing in this case.
update
Using the method shown by Leonid below, (the Macro trick), I wanted to use it to help me define number of controls, all using one common setting. This is what I tried:
Manipulate[{x, y},
Evaluate#With[
{
control1 = Function[{var, initialValue, str, from, to, incr},
{
{{var, initialValue, str}, from, to, incr, ImageSize -> Tiny}
}
,
HoldAll
]
},
{
First#control1[x, 0, "x=", 0, 1, .1],
First#control1[y, 0, "y=", 0, 2, .1],
First#control1[z, 0, "z=", 0, 10, .1]
},
]
]
The problem is just an extra {} around the whole thing, else it will work. Will keep trying to solve this. But getting close. Tried Sequence[], and Flatten[..,1] and such, but can not do it yet. Making more coffee, should help.
Update 2
This is below an example using Simon method to use to help define common definition across more than one control. This way, one can use it to reduce code duplication for common options on set of separate controls
Notice, had to use Control[] to get it to control.
Manipulate[{x, y, z},
Dynamic[Grid[{
{control1[x, 0, "x=", 0, 1, .1]},
{control1[y, 0, "y=", 0, 2, .1]},
{control1[z, 0, "z=", 0, 10, .1]}
}]],
{{control1,
Function[{var, initialValue, str, from, to, incr},
Control[{{var, initialValue, str}, from, to, incr,
ImageSize -> Tiny}], HoldFirst]}, None}
]
Update 3
And got Leonid method to work also on more than one control. The trick is to use Control[]. Can't use plain old {{x,0,"x"},...} [EDIT, yes, you can, just need the Sequence## method as shown below by Leonid update.].
Here it is:
Manipulate[{x, y, z},
Evaluate#With[
{
control1 = Function[{var, initialValue, str, from, to, incr},
Control[{{var, initialValue, str}, from, to, incr,
ImageSize -> Tiny}]
, HoldAll
]
},
Grid[{
{control1[x, 0, "x=", 0, 1, .1]},
{control1[y, 0, "y=", 0, 2, .1]},
{control1[z, 0, "z=", 0, 10, .1]}
}]
]
]
I'll try to integrate one of these methods into my main demo (has over 600 lines of code just for the control layout so far and growing by the minute, hopefully these methods will shrink this by quite a bit)
Update 9/26/11. 7 pm
I thought I post a 'birds eye' view of the code saving by using 'macros' to define controls which contains many common boiler-plate code. Here is a screen shot of before and after.
Thanks again for all the answer and help.
What about this
Manipulate[Plot[f*g, {x, -1, 1}],
Evaluate#
With[{styleAndpopup =
Function[{st, fun},
{
Style[st],
PopupMenu[Dynamic[fun], {x, x^2, x^3}, ImageSize -> Tiny]
},
HoldAll]},
Grid[{styleAndpopup["f(x)=", f], styleAndpopup["g(x)=", g]}]]]
This is actually a tiny example of the code-generation at work, since if you look at the FullForm of the resulting Manipulate, you will see the same expression you originally started with. The styleAndpopup is actually not a function here, but a macro, locally defined using With.
EDIT
Per request of the OP - generalizing to many controls. The easiest fix is to insert Sequence##... as Sequence ## {First#control1[.... However, there is some extraneous stuff that can be removed as well:
Manipulate[{x, y},
Evaluate#With[{control1 =
Function[{var, initialValue, str, from, to, incr},
Unevaluated#{{var, initialValue, str}, from, to, incr, ImageSize -> Tiny},
HoldAll]},
Sequence ## {
control1[x, 0, "x=", 0, 1, .1],
control1[y, 0, "y=", 0, 2, .1],
control1[z, 0, "z=", 0, 10, .1]}]]
I was going to give a solution almost the same as Leonid's and use With to insert the code, but he beat me to it, so here's an alternative way. Define a dynamic local function using ControlType -> None that does your styling:
Manipulate[Plot[{f, g + 1}, {x, -1, 1}],
Dynamic[Grid[{{Style["f(x)="], pu[f]},
{Style["g(x)="], pu[g]}}]],
{{pu, Function[{f}, PopupMenu[Dynamic[f], {x, x^2, x^3}, ImageSize -> Tiny],
HoldFirst]}, None}]
By the way, the Style[] in Style["f(x)="] is redundant, as you are not actually setting any styles...
One could do this:
Manipulate[
Plot[f*g, {x, -1, 1}]
, Grid[
{ {Style["f(x)="], PopupMenu[Dynamic[f], opts]}
, {Style["g(x)="], PopupMenu[Dynamic[g], opts]}
}
]
] /. opts -> Sequence[{x, x^2, x^3}, ImageSize -> Tiny]
If one is in the habit of assigning down-values to symbols whose names do not begin with $, then it would be prudent to wrap the whole thing in Block[{x, opts}, ...] in case x and opts have globally-defined values.
A similar technique is possible for the case of multiple controls:
Manipulate[
{x, y, z}
, Grid[
{ {control1[x, 0, "x=", 0, 1, .1]}
, {control1[y, 0, "y=", 0, 2, .1]}
, {control1[z, 0, "z=", 0, 10, .1]}
}
]
] /. control1[var_, initialValue_, str_, from_, to_, incr_] :>
Control[{{var, initialValue, str}, from, to, incr, ImageSize -> Tiny}]

Resources