Re: Adaptive FunctionInterpolation[] ?

*To*: mathgroup at smc.vnet.net*Subject*: [mg50152] Re: Adaptive FunctionInterpolation[] ?*From*: "franjesus" <franjesus at hotmail.com>*Date*: Wed, 18 Aug 2004 01:19:59 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

Now, I have this version that works with Mathematica v5. Makes use of NIntegrate EvaluationMonitor option. AdaptiveFunctionInterpolation[expr_, x__, opts___?OptionQ] := Module[{acc, g, gridpts, iarrays, niacc, pts, vars, vol}, acc = AccuracyGoal /. \ {opts} /. AccuracyGoal -> 6; vol = Times @@ ({x}[[All, 3]] - {x}[[All, 2]]); niacc = -Log[10, 10^-acc vol]; vars = {x}[[All, 1]]; pts = {}; NIntegrate[expr, x, AccuracyGoal -> niacc, EvaluationMonitor :> AppendTo[pts, {x}]]; pts = Partition[Flatten[pts], Length[vars]]; gridpts = ( Union[pts[[All, #1]], {x}[[1, {2, 3}]]] &) /@ Range[Length[vars]]; iarrays = expr /. Outer[Thread[vars -> {##1}] &, Sequence @@ gridpts]; ListInterpolation[iarrays, gridpts] ] Carl K. Woll wrote: > Hi Frank, > If you're interested, I can give you the workaround that I used when I came across this problem. My solution used the fact that NIntegrate must adaptively choose its integration points in order to accurately determine the numerical integral. Hence, if I use NIntegrate, and remember the data points which NIntegrate uses in its routines, I can use these data points to interpolate the desired function. I have no idea how good this approach is compared to other adaptive routines, but it required very little work from me to develop (that is, I didn't need to figure out an adaptive routine). Putting the above idea into a function yields the following: AdaptiveFunctionInterpolation[expr_, x__, opts___?OptionQ] := > Module[{acc, g, gridpts, iarrays, niacc, pts, vars, vol}, acc = AccuracyGoal /. {opts} /. AccuracyGoal -> 6; vol = Times @@ ({x}[[All,3]] - {x}[[All,2]]); niacc = -Log[10, 10^-acc vol]; > vars = {x}[[All,1]]; pts = {}; With[{v = vars}, Evaluate[g @@ (Pattern[#, _] & ) /@ vars] := Module[{}, pts = {v, pts}; expr]]; NIntegrate[g @@ vars, x, AccuracyGoal -> niacc]; pts = Partition[Flatten[pts], Length[vars]]; gridpts = (Union[pts[[All,#1]], {x}[[1,{2, 3}]]] & ) /@ Range[Length[vars]]; iarrays = expr /. Outer[Thread[vars -> {##1}] & , Sequence @@ gridpts]; ListInterpolation[iarrays, gridpts] ]