6
$\begingroup$

Update 2: Got two solid answers, but had trouble implementing one, and found the other could only save me computation time by sacrificing accuracy. So I chose neither as an official answer, but they're both worth looking at if you're trying to interpolate a "sharp" (not smooth) function.

Update: The main question has been answered, but my problem hasn't been solved. The problem is I have a situation where I want to use Which on an InterpolatingFunction several times to repeatedly "fold" the function. But I'm finding that as soon as I nest Which even once (i.e. use a Which'd function for both values of a new Which call), I get a slow down when using the resulting function of >300%. I can find no other explanation for the slowing down. So I'm attempting to turn the first Which into an InterpolatingFunction to simplify the final function. Any suggestions on a better solution?

I define these two functions:

x1 = FunctionInterpolation[Sin[t], {t, 0, 20}];
x2 = FunctionInterpolation[
   Which[x1[t] >= 0, x1[t], x1[t] < 0, -x1[t]], {t, 0, 20}];

and find that the latter gives a bizarre, incorrect function:

Plot[x1[t], {t, 0, 20}]
Plot[x2[t], {t, 0, 20}, PlotRange -> {-1.1, 1.1}]

plot of x1[t] plot of x2[t]

The problem is that the second graph should look like the absolute value of the first. I'm trying to understand why the combination of FunctionInterpolation -> Which -> FunctionInterpolation has this effect so I can fix it.

My actual code is more complex than this (this is just a reduced sample case), so workarounds specific to this case wouldn't be very helpful. Anyone know what's going on?

Improve this question
$\endgroup$
8
  • 1
    $\begingroup$ It probably has trouble with those kinks at y==0. Abs[Sin[t]] does better. $\endgroup$
    – march
    Commented Sep 1, 2015 at 21:36
  • $\begingroup$ Ah I think you're right. Can you suggest a way to get an interpolating function that allows those kinds of kinks? $\endgroup$
    – Max
    Commented Sep 1, 2015 at 21:40
  • $\begingroup$ Not off the top of my head. Why do you need it? Can you use Which outside the InterpolatingFunction? That is, interpolate the smooth function first (which will work nicely), then take the absolute value (or whatever it is you need to do) afterward. $\endgroup$
    – march
    Commented Sep 1, 2015 at 21:43
  • $\begingroup$ I have a situation where I want to use Which on an InterpolatingFunction several times to repeatedly "fold" the function. But I'm finding that as soon as I nest Which even once (i.e. use a Which'd function for both values of a new Which call), I get a slow down when using the resulting function of >300%. I can find no other explanation for the slowing down. So I'm attempting to turn the first Which into an InterpolatingFunction to simplify the final function. Any suggestions on a better solution? $\endgroup$
    – Max
    Commented Sep 1, 2015 at 21:50
  • 1
    $\begingroup$ Try PiecewiseExpand on the Which statements to see if you can avoid interpolating. $\endgroup$
    – Michael E2
    Commented Sep 1, 2015 at 23:28

2 Answers 2

Reset to default
8
$\begingroup$

Protecting the expression with NumericQ works, too.

x1 = FunctionInterpolation[Sin[t], {t, 0., 20.}];
x2n[t_?NumericQ] := Which[x1[t] >= 0, x1[t], x1[t] < 0, -x1[t]];
x2 = FunctionInterpolation[x2n[t], {t, 0., 20.}, 
   MaxRecursion -> 15, AccuracyGoal -> 5];

Plot[x2[t], {t, 0, 20}, PlotRange -> {-1.1, 1.1}]

Mathematica graphics

Addendum: To increase accuracy, the accuracy of all computations need to be increased, including x1.

x1 = FunctionInterpolation[Sin[t], {t, 0., 20.}, PrecisionGoal -> 12, 
   AccuracyGoal -> 11, MaxRecursion -> 25];
x2n[t_?NumericQ] := Which[x1[t] >= 0, x1[t], x1[t] < 0, -x1[t]];
x2 = FunctionInterpolation[x2n[t], {t, 0., 20.}, MaxRecursion -> 35, 
   AccuracyGoal -> 10, PrecisionGoal -> 11];

Plot[x2[t] - Abs[Sin[t]], {t, 0, 20}, PlotRange -> All]

Mathematica graphics

Improve this answer
$\endgroup$
9
  • $\begingroup$ Doesn't work on V9 ;( $\endgroup$
    – Dr. belisarius
    Commented Sep 2, 2015 at 2:07
  • $\begingroup$ @belisarius D'oh. Misedited the code. Should work now. $\endgroup$
    – Michael E2
    Commented Sep 2, 2015 at 2:16
  • 1
    $\begingroup$ Much better +1:) It looked odd, indeed. BTW, don't you wonder how a wrong answer gets upvoted ? $\endgroup$
    – Dr. belisarius
    Commented Sep 2, 2015 at 2:44
  • $\begingroup$ @belisarius All the time. :) Thanks. $\endgroup$
    – Michael E2
    Commented Sep 2, 2015 at 9:49
  • $\begingroup$ Unfortunately I need higher accuracy than 5, preferably around 10 or more. Do you know a way to push up the accuracy of FunctionInterpolation (besides just changing AccuracyGoal, which doesn't work here)? $\endgroup$
    – Max
    Commented Sep 2, 2015 at 16:37
6
$\begingroup$

You may use the unlinkedly documented option InterpolationPoints

x1 = FunctionInterpolation[Sin[t], {t, 0, 20},  InterpolationPoints -> 1000];
x2 = FunctionInterpolation[ Which[x1[t] >= 0, x1[t], x1[t] < 0, -x1[t]], {t, 0, 20}, 
                           InterpolationPoints -> 1000];
Plot[x2[t], {t, 0, 20}]

Mathematica graphics

These are the Options for FunctionInterpolation:

Options[FunctionInterpolation]

{InterpolationOrder->3,
 InterpolationPrecision->Automatic,
 AccuracyGoal->Automatic,
 PrecisionGoal->Automatic,
 InterpolationPoints->11,
 MaxRecursion->6}
Improve this answer
$\endgroup$
4
  • $\begingroup$ I'm trying to get better accuracy on this but with little success. Using (InterpolationPoints -> 10000, AccuracyGoal -> 10, PrecisionGoal -> 10, InterpolationPrecision -> 10), I still can't get past an error of ~10^-7 for Plot[x2[t] - Abs[Sin[t]], {t, 0, 20}]. Any thoughts on making this more accurate? $\endgroup$
    – Max
    Commented Sep 2, 2015 at 16:58
  • $\begingroup$ @Max Are you setting those options in both Interplations? How are you measuring the error? Can you post that code? $\endgroup$
    – Dr. belisarius
    Commented Sep 2, 2015 at 19:13
  • $\begingroup$ x1 = FunctionInterpolation[ Sin[t], {t, 0, 2 Pi}, InterpolationPoints -> 10000]; x2 = FunctionInterpolation[ Which[x1[t] >= 0, x1[t], x1[t] < 0, -x1[t]], {t, 0, 2 Pi}, InterpolationPoints -> 10000]; Plot[x2[t] - Abs[Sin[t]], {t, 0, 2 Pi}, PlotRange -> All] gives me 10^-15 (MachinePrecision) $\endgroup$
    – Dr. belisarius
    Commented Sep 2, 2015 at 19:28
  • $\begingroup$ You were right, I hadn't realized I would need to use InterpolationPoints on my initial function too (you may want to add that to your post). However I'm finding that to get my desired accuracy I need at least InterpolationPoints->10000, and that requirement takes so long that my code ends up even slower than it started. I really liked your idea, but seems it didn't work out for my purposes. Thanks for the help though! $\endgroup$
    – Max
    Commented Sep 3, 2015 at 21:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.