Hallo Frank,
Ich muss allerdings gestehen, dass ich sie nicht sofort verstanden habe und mich nach Olivers Antwort auch nicht mehr darum bemüht habe, da sie etwas kompliziert aussieht.
Mit dieser Ignoranz haben Sie recht, denn die Funktion breitlingWegbedungen[] greift in den Funktionsverlauf ein, anstatt - wie gewünscht - Stützstellen zu entfernen. Deshalb ist breitlingWegbedungen[] eine Fehlleistung.
Noch einfacher als die Verwendung von InterpolatingFunctionAnatomy ist jedoch das self-sampling:
In[256]:= breitlingWegbedungen2[f_InterpolatingFunction, l_List, dx_:20] :=
Block[{x, x1, x2, x3, x4},
{x1, x2, x3, x4} = l;
Check[Plus @@ (f[#] & /@ l), Return[$Failed]];
Interpolation[Join[Table[{x, f[x]}, {x, x1, x2, (x2 - x1)/dx}],
Table[{x, f[x]}, {x, x3, x4, (x4 - x3)/dx}]]]
] /; VectorQ[l, NumericQ] && Less @@ l && Length[l] == 4
Das self-sampling hat den Vorteil, dass es weitgehend unabhängig von der
Anzahl der Stützstellen ist. samp1 und samp2
In[95]:= Clear[samp1, samp2, x1, x2]
x1 = Sort[Join[{0.0}, RandomReal[{0., 10.}, 15], {10.}]];
samp1 = Transpose[{x1, BesselJ[1, #] & /@ x1}];
x2 = Sort[Join[{0.0}, RandomReal[{0., 10.}, 100], {10.}]];
samp2 = Transpose[{x2, BesselJ[1, #] & /@ x2}];
sind zwei unterschiedlich grosse Testmengen einer Besselfunktion. Die
Bearbeitung mit breitlingWegbedungen2[] zeigt nur eine geringe
Abhängigkeit von der Anzahl der Testpunkte:
In[268] := Clear[t1, t2]
t1 = breitlingWegbedungen2[Interpolation[samp1], {0, 3, 8, 10}];
t2 = breitlingWegbedungen2[Interpolation[samp2], {0, 3, 8, 10}];
Plot[{t1[x], t2[x]}, {x, 0, 10}, PlotLabel -> "Selfsampling"]
Das Verfahren mit InterpolatingFunctionAnatomy
In[1]:= Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"]
(* F. Breitling, 21. 5. 2010 *)
In[260]:= f1[r_] = Interpolation[samp1][r];
f2[r_] = Interpolation[samp2][r];
p1 = Select[First[InterpolatingFunctionCoordinates[f1[r][[0]]]],
Not[3. < # < 8.] &];
p2 = Select[First[InterpolatingFunctionCoordinates[f2[r][[0]]]],
Not[3. < # < 8.] &];
f11[r_] =
Interpolation[Transpose[{Transpose[{p1}], f1[p1], f1'[p1]}]][r];
f21[r_] =
Interpolation[Transpose[{Transpose[{p2}], f2[p2], f2'[p2]}]][r];
Plot[{f11[x], f21[x]}, {x, 0, 10}, PlotLabel -> "Punktentfernung"]
zeigt dagegen selbstverständlich eine deutliche Abhängigkeit von der
Anzahl der Stützstellen.
Gruss Udo.
selfsampling.jpeg
Description: JPEG image
punktentfernung.jpeg
Description: JPEG image
