I want to "modify" Mathematica's Interpolation[] function (in 1 dimension) by replacing extrapolation with constant values when the input is out of range.
In other words, if the interpolation domain is [1,20] and f[1]==7 and f[20]==12, I want:
f[x] = 7 for x<=1
f[x] = 12 for x>=20
f[x] = Interpolation[...]
However, this fails:
(* interpolation w cutoff *)
interpcut[r_] := Module[{s, minpair, maxpair},
(* sort array by x coord *)
s = Sort[r, #1[[1]] < #2[[1]] &];
(* find min x value and corresponding y value *)
minpair = s[[1]];
(* ditto for max x value *)
maxpair = s[[-1]];
(* return the pure function representing cutoff interpolation *)
Piecewise[{
{minpair[[2]] &, #1 < minpair[[1]] &},
{maxpair[[2]] &, #1 > maxpair[[1]] &},
{Interpolation[r], True}
}]]
test = Table[{x,Prime[x]},{x,1,10}]
InputForm[interpcut[test]]
Piecewise[{{minpair$59[[2]] & , #1 < minpair$59[[1]] & },
{maxpair$59[[2]] & , #1 > maxpair$59[[1]] & }}, 开发者_如何学编程
InterpolatingFunction[{{1, 10}}, {3, 1, 0, {10}, {4}, 0, 0, 0, 0},
{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}}, {{2}, {3}, {5}, {7}, {11}, {13}, {17},
{19}, {23}, {29}}, {Automatic}]]
I'm sure I'm missing something basic. What?
Function definition
interpcut[r_, x_] :=
Module[{s},(*sort array by x coord*)
s = SortBy[r, First];
Piecewise[
{{First[s][[2]], x < First[s][[1]]},
{Last [s][[2]], x > Last [s][[1]]},
{Interpolation[r][x], True}}]];
Test
test = Table[{x, Prime[x]}, {x, 1, 10}];
f[x_] := interpcut[test, x]
Plot[f[x], {x, -10, 30}]
Edit
Answering your comment about pure functions.
I did it that way just for clarity, not for cheating. For using pure functions just "follow the recipe":
interpcut[r_] := Module[{s},
s = SortBy[r, First];
Function[Piecewise[
{{First[s][[2]], # < First[s][[1]]},
{Last [s][[2]], # > Last [s][[1]]},
{Interpolation[r][#], True}}]]
]
test = Table[{x, Prime[x]}, {x, 1, 10}];
f = interpcut[test] // InputForm
Plot[interpcut[test][x], {x, -10, 30}]
Let me add an update to this old thread. Since V9 you can use native (but still experimental) "ExtrapolationHandler" parameter
test = Table[{x, Prime[x]}, {x, 1, 10}];
g = Interpolation[test, "ExtrapolationHandler" ->
{If[# <= test[[1, 1]], test[[1, 2]], test[[-1, 2]]] &,
"WarningMessage" -> False}];
Plot[g[x], {x, -10, 30}]
Here's a possible alternative to belisarius's answer:
interpcut[r_] := Module[{s}, s = SortBy[r, First];
Composition[Interpolation[r], Clip[#, Map[First, Through[{First, Last}[s]]]] &]]
精彩评论