Hermite, Splines

Beispiel * Exemple

h0[x_]:=2x^3-3x^2+1;
h1[x_]:=x^3-2x^2+x;
h2[x_]:=x^3-x^2;
h3[x_]:=1-h0[x];
pH[x_,y1_,m1_,m2_,y2_]:=y1 h0[x]+m1 h1[x]+m2 h2[x]+y2 h3[x];

Plot[{h0[x],h1[x],h2[x],h3[x]},{x,0,1}];

Plot[{h0[x],h1[x],h2[x],h3[x],pH[x,2,8,-2,3]},{x,0,1}];

xL[1]=0;
xL[2]=1;
xL[3]=2;
xL[4]=4;

t[x_,k_]:=(x-xL[k])/(xL[k+1]-xL[k])

Table[t[x,k],{k,1,3}]

p1[x_]:=0;
p1[x_ /;(x>0) && (x<1)]:=pH[t[x,1],2,1,0,3];

Plot[p1[x],{x,-1,2}];

p2[x_]:=0;
p2[x_ /;(x>=1) && (x<2)]:=pH[t[x,2],3,0,-0.5,1];
Plot[p2[x],{x,-1,3}];

p3[x_]:=0;
p3[x_ /;(x>=2) && (x<4)]:=pH[t[x,3],1,-0.5,1,3];
Plot[p3[x],{x,-1,4}];

p[x_]:=p1[x]+p2[x]+p3[x];

?Epilog

Plot[p[x],{x,-1,4},Epilog->{PointSize[0.05],Hue[1],Point[{0,2}],Point[{1,3}],Point[{2,1}],Point[{4,3}]}];

Programmierung * Programmation

Remove["Global`*"]

Daten * Données

?Sort

randList[n_] := 
        Sort[Table[
            n {Random[], Random[]}, {k, 1, 
              n}]];
randList[20]

fixRandList = randList[20];
transRandList = Transpose[fixRandList];
MatrixForm[transRandList]

pTabRandList = Map[Point, fixRandList];
Show[
        Graphics[{PointSize[0.03], Hue[1], pTabRandList}]];

Polynome * Polynômes

h0[x_] := 2  x^3 - 3  x^2 + 1;
h1[x_] := x^3 - 2  x^2 + x;
h2[x_] := x^3 - x^2;
h3[x_] := 1 - h0[x];
pH[x_, y1_, m1_, m2_, y2_] := 
        y1 h0[x] + m1 h1[x] + m2 h2[x] + y2 h3[x];

Koordinaten, Steigungen, Intervalltransformation * Coordonnées, pentes, transformation des intervalles

k ∈ {1,2,...., Length[fixRandList - 1] }

xL[k]=0;yL[k]=0;
xL[k_?IntegerQ]:=transRandList[[1]][[k]];
yL[k_?IntegerQ]:=transRandList[[2]][[k]];

transRandList[[1]]

transRandList[[2]]

Remove[a, b, c, a1, a2, b1, b2, c1, c2]

pInit[x_, a_, b_, c_] := a x^2 + b x  +  c;

gleich1 = {
pInit[xL[1], a1, b1, c1] == 
          yL[1], 
pInit[xL[2], a1, b1, c1] == 
          yL[2], 
pInit[xL[3], a1, b1, c1] == 
          yL[3]}

Flatten[Solve[gleich1, {a1, b1, c1}]]

gleich1 = {
pInit[xL[1], a1, b1, c1] == 
            yL[1], 
pInit[xL[2], a1, b1, c1] == 
            yL[2], 
pInit[xL[3], a1, b1, c1] == 
            yL[3]};
pInit1[x, a1, b1, c1] := 
        pInit[x, a1, b1, c1] /.  
          Flatten[Solve[gleich1, {a1, b1, c1}]];
pInit1[x, a1, b1, c1]

m[1] = D[pInit1[x, a1, b1, c1], x] /. {x -> xL[1]}

n =  Length[fixRandList]

gleich2 = {
pInit[xL[n - 2], a2, b2, c2] == 
            yL[n - 2], 
pInit[xL[n - 1], a2, b2, c2] == 
            yL[n - 1], 
pInit[xL[n], a2, b2, c2] == 
            yL[n]};
pInit2[x, a2, b2, c2] := 
        pInit[x, a2, b2, c2] /.  
          Flatten[Solve[gleich2, {a2, b2, c2}]];
pInit2[x, a2, b2, c2]

m[n] = D[pInit2[x, a2, b2, c2], x] /. {x -> xL[n]}

m[k_ /;  (k > 1)  &&  (k <  Length[fixRandList])] := (yL[
              k + 1] - yL[k - 1])/(xL[k + 1] - xL[k - 1])

mTabl = Table[m[k], {k, 1, n}]

t[x_, k_] := 0

t[x_,k_?IntegerQ]:=(x-xL[k])/(xL[k+1]-xL[k])

Table[t[x, k], {k, 1, n - 1}]

t[x, 3]

t[x, k]

yL[4]

yL[k]

pH[t[x, k], yL[k], m[k], m[k + 1], yL[k + 1]]

pH[t[x, 5], yL[5], m[5], m[5 + 1], yL[5 + 1]]

pH[t[x, 5], yL[5], m[5], m[5 + 1], yL[5 + 1]] // Simplify // 
      Expand

n

pH[t[x, 5], yL[5], m[5], m[5 + 1], yL[5 + 1]]

pKurzH[x_, k_] := 
        pH[t[x, k], yL[k], m[k], m[k + 1], 
          yL[k + 1]];
pKurzH[x, 5]

p[x_, k_] := 
        If[TrueQ[x >= k]  && TrueQ[x < k + 1],   pKurzH[x, k]    ,  
          0];
p[5.5, 5]

p[x, k]

Plot[p[x, 5], {x, xL[1], xL[n]}];

p[x, 1]

q[x_, 
          k_] := (x ≥ xL[k]) && (x < 
                xL[k + 1]) /. {True -> 1, 
            False -> 0};
Table[q[5.5,  k], {k, 0, 20}]

p[x_,  k_] := 
        pH[t[x, k], yL[k], m[k], m[k + 1], yL[k + 1]] * 
          q[x, k];

Table[p[5.5,  k], {k, 0, 19}]

pTot[x_] := 0
pTot[x_] := Sum[p[x,  k], {k, 1, n - 1}]

Table[pTot[x], {x, -2, 30, 0.5}]

Plot[pTot[x], {x, 0, n}, 
        Epilog -> {PointSize[0.03], Hue[1], pTabRandList}];

Programm * Programme

Remove["Global`*"]

Modul * Module

\(splines[enterList_?MatrixQ] := 
      Module[
{fixList, n, transList, pTabList, h0, h1, h2, 
          h3, pH, pInit, x, a, b, c, gleich1, a1, b1, c1, pInit1, gleich2, 
          a2, b2, c2, pInit2, t, q, p, k, pTot, epsX, epsY, plotMin, \ 
          plotMax}, 
fixList = 
          Sort[enterList]; 
n = \ 
          Length[fixList]; 
transList = 
          Transpose[
            fixList]; 
If[\((n > 2)\)\  && \ \((\ 
              Length[transList[\([1]\)]] == \ 
                Length[Union[
                    transList[\([1]\)]]])\), 
pTabList = 
            Map[Point, fixList]; 
h0[x_] := 
            2  x^3 - 3  x^2 + 1; 
h1[x_] := 
            x^3 - 2  x^2 + x; 
h2[x_] := 
            x^3 - x^2; 
h3[x_] := 
            1 - h0[x]; 
pH[x_, y1_, m1_, m2_, y2_] := 
            y1\ h0[x] + m1\ h1[x] + m2\ h2[x] + 
              y2\ h3[x]; 
xL[k] = 
            0; 
yL[k] = 
            0; 
xL[
              k_?IntegerQ] := \(transList[\([1]\)]\)[\([k]\)]; 
yL[
              k_?IntegerQ] := \(transList[\([2]\)]\)[\([k]\)]; 
pInit[x_, a_, b_, c_] := 
            a\ x^2 + b\ x\  + \ 
              c; 
gleich1 = {
pInit[
                  xL[1], a1, b1, c1] == 
                yL[1], 
pInit[xL[2], a1, b1, c1] == 
                yL[2], 
pInit[xL[3], a1, b1, c1] == 
                yL[3]}; 
pInit1[x, a1, b1, c1] := 
            pInit[x, a1, b1, c1] /. \ 
              Flatten[Solve[
                  gleich1, {a1, b1, 
                    c1}]]; 
gleich2 = {
pInit[xL[n - 2], a2, b2, c2] == 
                yL[n - 2], 
pInit[xL[n - 1], a2, b2, c2] == 
                yL[n - 1], 
pInit[xL[n], a2, b2, c2] == 
                yL[n]}; 
pInit2[x, a2, b2, c2] := 
            pInit[x, a2, b2, c2] /. \ 
              Flatten[Solve[gleich2, {a2, b2, c2}]]; 
m[
              1] = D[pInit1[x, a1, b1, c1], 
                x] /. {x -> xL[1]}; 
m[n] = 
            D[pInit2[x, a2, b2, c2], x] /. {x -> xL[n]}; 
m[
            
            k_ /; \ \((k > 1)\)\  && \ \((k < \ Length[fixList])\)] := \((yL[
                    k + 1] - yL[k - 1])\)/\((xL[k + 1] - 
                  xL[k - 1])\); 
t[x_, k_] := 
            0; 
t[x_, 
              k_?IntegerQ] := \((x - xL[k])\)/\((xL[k + 1] - 
                  xL[k])\); 
q[x_, 
              k_] := \((x ≥ xL[k])\) && \((x < 
                    xL[k + 1])\) /. {True -> 1, 
                False -> 0}; 
p[x_, \ k_] := 
            pH[t[x, k], yL[k], m[k], m[k + 1], yL[k + 1]]\ *\ 
              q[x, k]; 
pTot[x_] := 
            0; 
pTot[x_] := 
            Sum[p[x, \ k], {k, 1, 
                n - 1}]; 
epsX = \((Min[
                    Table[\((xL[k] - xL[k - 1])\), {k, 2, n}]] + 
                  Max[Table[\((xL[k] - xL[k - 1])\), {k, 2, n}]])\)/
              2; 
epsY = \((Min[
                    Table[\((yL[k] - yL[k - 1])\), {k, 2, n}]] + 
                  Max[Table[\((yL[k] - yL[k - 1])\), {k, 2, n}]])\)/
              2; 
plotMin = 
            Min[transList[\([2]\)]] - epsY; 
plotMax = 
            Max[transList[\([2]\)]] + epsY; 
Plot[
            pTot[x], {x, xL[1], xL[n]}, 
            Epilog -> {PointSize[0.03], Hue[1], pTabList}, 
            PlotLabel -> {"1. Automatic Plot"}]; 
Plot[pTot[x], {x, xL[1] - epsX, xL[n] + epsX}, 
            Epilog -> {PointSize[0.03], Hue[1], pTabList}, 
            PlotRange -> {plotMin, plotMax}, 
            PlotLabel -> {"2. PlotRange Plot"}];\ \ , \ \ \ \(Print["Zu wenig Punkte oder gleiche x-Koordinaten !!! -- Trop peu de points ou des coordonnées x égales !!!"];\)]
]\)

Daten eingeben, Rechnung * Entrer les données, calcul

Biespiel * Exemple

randList[n_] := 
        Sort[Table[n {Random[], Random[]}, {k, 1, n}]];

Rechnungen (Beispiele) * Des Calculs (exemples)

fixList = randList[50];
splines[fixList]

fixList = randList[15];
splines[fixList]

fixList = randList[3];
splines[fixList]

fixList = randList[2];
splines[fixList]

fixList = {{1, 2}, {1, 3}, {2, 4}};
splines[fixList]

fixList = {{1, 2}, {5, 3}, {2, 4}};
splines[fixList]