Как извлечь все данные из InterpolatingFunction для создания идентичного?

в комментариях к моей предыдущий вопрос было предложено извлечь все данные из InterpolatingFunction создается с помощью Mathematica 5.2, а затем создать еще один Mathematica 8. Предлагаемый подход заключается в использовании функций, определенных в DifferentialEquations`InterpolatingFunctionAnatomy` пакет для извлечения данных из InterpolatingFunction. Пробую наивно,

Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"]
ifun = First[
   x /. NDSolve[{x'[t] == Exp[x[t]] - x[t], x[0] == 1}, 
     x, {t, 0, 10}]];
data = Transpose@{InterpolatingFunctionGrid[ifun], 
    InterpolatingFunctionValuesOnGrid[ifun]};
interpolationOrder = 
  Developer`FromPackedArray@
   InterpolatingFunctionInterpolationOrder[ifun];
ifun2 = Interpolation[data, InterpolationOrder -> interpolationOrder];
Table[ifun[x] - ifun2[x], {x, 0, 0.5160191740198963`, .1}]

Я получаю значительную разницу между исходной функцией и реконструированной один:

{0., 2.13061*10^-7, 2.05087*10^-7, 2.46198*10^-7, 6.68937*10^-7, 
 1.5624*10^-7}

смотрим InputForm из этих функций показывает, что они не идентичны. Можно ли реконструировать InterpolatingFunction через извлечение всех данных из него и вызов Interpolation на извлеченных данных?

6
wolfram-mathematica

1 ответов

редактировать

вот общее решение, в коде:

Clear[reconstructInterpolatingFunction];
reconstructInterpolatingFunction[intf_InterpolatingFunction] :=
   With[{data = intf[[4, 3]], 
      step = Subtract @@ Reverse[ Take[intf[[4, 2]], 2]],
      order = 
          Developer`FromPackedArray@
              InterpolatingFunctionInterpolationOrder[intf],
      grid = InterpolatingFunctionGrid[intf]
      },
     Interpolation[
         MapThread[Prepend, {Partition[data, step], grid}], 
         InterpolationOrder -> order
     ]
   ];

пожалуйста, см. ниже для объяснения. Обратите внимание, однако, что приведенный выше код зависит от некоторых деталей InterpolatingFunction объект, который может быть специфичным для версии, поскольку, по-видимому, API DifferentialEquations`InterpolatingFunctionAnatomy` не позволяет полностью восстановить исходный объект, когда значения для производных функций важны.

конец EDIT

получается, что NDSolve включает информацию о производных при построении InterpolatingFunction, который имеет смысл. В вашем случае это будет включать первую производную, так как ваше уравнение является первым порядком. Но эта информация теряется, когда мы используем функции из DifferentialEquations` InterpolatingFunctionAnatomy` пакета. Способ получить его-получить доступ к initial InterpolatingFunction объект напрямую. Вот простой пример:

In[156]:= ifun=First[x/.NDSolve[{x'[t]==2x[t],x[0]==1},x,{t,0,0.1}]];

In[157]:= ifun[[4,3]]
Out[157]= {1.,2.,1.00002,2.00004,1.00004,2.00008,1.00457,2.00913,1.00911,2.01823,
1.01368,2.02736,1.02787,2.05573,1.04225,2.0845,1.05684,2.11368,1.07163,2.14326,
1.09328,2.18655,1.11536,2.23073,1.13789,2.27579,1.16088,2.32176,1.18433,2.36867,
1.20272,2.40545,1.2214,2.44281}

это говорит о том, что каждое значение затем значение производной, в этой точке сетки. Поэтому Способ построения нового объекта выглядит примерно так:

ifun5 = 
Interpolation[
   MapThread[Prepend, 
  {Partition[ifun[[4, 3]], 2], InterpolatingFunctionGrid[ifun]}], 
  InterpolationOrder -> (interpolationOrder)]

это использует расширенную форму Interpolation, где можно указать значения для производных. Это проходит наш тест:

In[161]:= Table[(1-ifun5[x]/ifun[x]),{x,0,0.1,.01}]
Out[161]= {0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.}

способ определить, до какой производной мы имеем информацию в указанной InterpolatingFunction смотреть на эту часть:

In[176]:= ifun[[4,2]]
Out[176]= {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34}

в этом случае шаг равен 2, поэтому у нас есть значение плюс первая производная. Для, скажем, уравнения второго порядка шаг будет 3, и вам понадобится Partition[...,3]. Таким образом, вы определяете порядок, получая шаг в этой части.

Итак, реальная вещь:

In[162]:= 
ifun=First[x/.NDSolve[{x'[t]==Exp[x[t]]-x[t],x[0]==1},x,{t,0,10}]];
interpolationOrder=Developer`FromPackedArray@InterpolatingFunctionInterpolationOrder[ifun];
ifunnew = Interpolation[MapThread[Prepend,  
{Partition[ifun[[4,3]],2],InterpolatingFunctionGrid[ifun]}],
 InterpolationOrder->(interpolationOrder)];
Table[(1-ifunnew[x]/ifun[x]),{x,0,0.5,.1}]

During evaluation of In[162]:= NDSolve::ndsz: At t == 0.5160191740198969`, 
step size is effectively zero; singularity or stiff system suspected. >>
Out[165]= {0.,0.,0.,1.11022*10^-16,0.,0.}
5