Kurve durch Punkte 
- Courbe qui passe par des points donnés

(von - de ... Rolf Wirz)

Polynomkurve durch gegebene Punkte 
- Courbe polynomiale qui passe par des points donnés

Programm - Programme

\(\(\(Remove["Global`*"]\)\(
\)\(
\)\( (*\ \(===\)\(===\)\(===\)\(===\)\(===\)\(===\)\(\(==\)\(>\)\(\ \)\(Module\)\)\ *) \)\(
\)
    \)\)
\(\(fnPlot[expr_, k_, xU_, xO_, pSize_, 
          over_] := 
Module[{f, fkt, pl1, n, p, z, ta, 
            kInt, q, aa, bb, li, taGl, solv, pl2, pl3, a, x, g, h, 
            sh}, 

fkt[f_, x_] := 
            Apply[f, {x}]; 
 (*\ \(pl1 = 
                Plot[fkt[expr, x], {x, xU, xO}];\)\ *) 
z[
              n_, kInt_] := 
            xU + n\ *\((xO - xU)\)/kInt; 
p[n_, kInt_] := 
            Point[{z[n, kInt], 
                fkt[expr, z[n, kInt]]\ }]; 
ta[kInt_] := 
            Table[p[n, kInt], {n, 0, kInt}]; 
pl2 = 
            Plot[fkt[expr, x], {x, xU - \(\((xO - xU)\)/k\)/2, 
                xO + \(\((xO - xU)\)/k\)/2}, 
              Epilog -> {PointSize[pSize], ta[k]}, 
              DisplayFunction -> Identity]; \ 
q[
              aa_ + bb_] := q[aa] + q[bb]; 
q[aa_ + bb_] := 
            q[aa] + q[bb]; 
q[aa_\ bb_] := 
            q[aa]\ q[bb]; 
q[x_] := 
            x; 
Unprotect[q]; 
li = 
            Table[a[n]\ x^n, {n, 0, k}]; 
taGl[kInt_] := 
            Table[\((q[Plus @@ li] /. x -> z[n, kInt])\) == 
                fkt[expr, z[n, kInt]], {n, 0, kInt}]; 
solv[
              kInt_] := Solve[taGl[kInt], Table[a[n], {n, 0, kInt}]] // 
              Flatten; 
g[h_, kInt_] := 
            q[Plus @@ li] /. 
              Union[solv[kInt], {x -> h}]; 
pl3 = 
            Plot[g[x, k], {x, xU - \(\((xO - xU)\)/k\)/2, 
                xO + \(\((xO - xU)\)/k\)/2}, AspectRatio -> Automatic, 
              DisplayFunction -> Identity]; 
sh = 
            Show[pl2, pl3, 
              DisplayFunction -> $DisplayFunction]; 
pl4 = 
            Plot[g[x, k], {x, xU - over \((xO - xU)\)/k, 
                xO + over \((xO - xU)\)/
                      k}]; 
Print["Polynome[v] =  ", 
            g[v, k] // 
              N, \ \ \ " ===> Look at the coefficients!"]
];\)\)

Beispiele - Exemples

(* ====================> Data0a *)

expr[x_]:=Sin[x];
k=1;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=10000;

(* ====================> Plot0a *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data0b *)

expr[x_]:=Sin[x];
k=2;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=5;

(* ====================> Plot0b *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data0c *)

expr[x_]:=Sin[x];
k=3;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=5;

(* ====================> Plot0c *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data0d *)

expr[x_]:=Sin[x];
k=4;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=5;

(* ====================> Plot0d *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data0e *)

expr[x_]:=Sin[x];
k=5;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=10;

(* ====================> Plot0e *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data0f *)

expr[x_]:=Sin[x];
k=10;
{xU,xO}={0,Pi};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=10;

(* ====================> Plot0f *)

fnPlot[expr,k,xU,xO,pSize,over];

expr[
          x_] := E^(-x^2);

    k = 11;

    {xU, xO} = {-2.5, 
          2.5};    

    pSize = 0.03;

    over = 
        10000;

  


    fnPlot[expr, k, xU, xO, pSize, over];

expr[
          x_] := E^(-x^2);

    k = 6;

    {xU, xO} = {-2.5, 
          2.5};    

    pSize = 0.03;

    over = 
        10;

  


    fnPlot[expr, k, xU, xO, pSize, over];

expr[
          x_] := Sin[x];

    k = 10;

    {xU, xO} = {-2.5, 
          5};    

    pSize = 0.03;

    over = 
        0.5;

  


    fnPlot[expr, k, xU, xO, pSize, over];

expr[
          x_] := Sin[x];

    k = 10;

    {xU, xO} = {-10, 
          10};    

    pSize = 0.03;

    over = 
        2;

  


    fnPlot[expr, k, xU, xO, pSize, over];

expr[
          x_] := E^(-x^4 + x + 1);

    k = 11;

    {xU, xO} = {-2.5, 
        2.5};     
pSize = 
      0.03;

    over = 
        10000;

  


    fnPlot[expr, k, xU, xO, pSize, 
        over];

(* ====================> Data6 ===>  Rechenzeit! Temps pour calculer! *)

expr[x_]:=E^(-x^4+x+1);
k=11;
{xU,xO}={-20,20};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=10000;

(* ====================> Plot6 *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data7 *)

expr[x_]:=1/(x^2 +1);
k=11;
{xU,xO}={-5,5};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=100;

(* ====================> Plot7 *)

fnPlot[expr,k,xU,xO,pSize,over];

(* 
      Vergleich von oben / 
              Comparer avec en haut  ===  ===  = =============> Data1 *) 

expr[x_] := 
        E^(-x^2);

    k = 11;

    {xU, xO} = {-2.5, 
        2.5};    (* Print[ {xU, 
            xO, {xU, xO}}];  *) 
pSize = 
      0.03;

    over = 10000;

    fnPlot[expr, k, xU, xO, pSize, over];

     (* ====================> Plot1 / Vergleich mit Plot 7  -  
            comparer avec plot 7 *)

Animate!

\(\(\(Remove["Global`*"]\)\(
\)\(
\)\( (*\ \(===\)\(===\)\(===\)\(===\)\(===\)\(===\)\(\(==\)\(>\)\(\ \)\(Module\)\)\ *) \)\(
\)
    \)\)
fnPlot[expr_, k_, xU_, xO_, pSize_, 
          over_] := 
Module[{f, fkt, pl1, n, p, z, ta, 
            kInt, q, aa, bb, li, taGl, solv, pl2, pl3, a, x, g, h, 
            sh}, 

fkt[f_, x_] := 
            Apply[f, {x}]; 
 (* pl1 = 
                Plot[fkt[expr, x], {x, xU, xO}]; *) 
z[
              n_, kInt_] := 
            xU + n *(xO - xU)/kInt; 
p[n_, kInt_] := 
            Point[{z[n, kInt], 
                fkt[expr, z[n, kInt]] }]; 
ta[kInt_] := 
            Table[p[n, kInt], {n, 0, kInt}]; 
pl2 = 
            Plot[fkt[expr, x], {x, xU - (xO - xU)/k/2, 
                xO + (xO - xU)/k/2}, 
              Epilog -> {PointSize[pSize], ta[k]}, 
              AspectRatio -> Automatic, 
              DisplayFunction -> Identity];  
q[
              aa_ + bb_] := q[aa] + q[bb]; 
q[aa_ + bb_] := 
            q[aa] + q[bb]; 
q[aa_ bb_] := 
            q[aa] q[bb]; 
q[x_] := 
            x; 
Unprotect[q]; 
li = 
            Table[a[n] x^n, {n, 0, k}]; 
taGl[kInt_] := 
            Table[(q[Plus @@ li] /. x -> z[n, kInt]) == 
                fkt[expr, z[n, kInt]], {n, 0, kInt}]; 
solv[
              kInt_] := Solve[taGl[kInt], Table[a[n], {n, 0, kInt}]] // 
              Flatten; 
g[h_, kInt_] := 
            q[Plus @@ li] /. 
              Union[solv[kInt], {x -> h}]; 
pl3 = 
            Plot[g[x, k], {x, xU - (xO - xU)/k/2, 
                xO + (xO - xU)/k/2}, AspectRatio -> Automatic, 
              DisplayFunction -> Identity]; 
sh = 
            Show[pl2, pl3, 
              DisplayFunction -> $DisplayFunction];
];

    
expr[x_] := 1/(x^2 + 1);
{xU, xO} = {-5, 5};   pSize = 
      0.03;
\(\(over = 
        100;\)

 (*\ \(===\)\(===\)\(===\)\(===\)\(===\)\(===\)\(\(==\)\(>\)\(Plot7\)\)*) 
\)
Table[
      fnPlot[expr, kIntern, xU, xO, pSize, over], {kIntern, 1, 
        11}];     ;

Runge!!

Plot[Evaluate[D[1/(x^2+1),{x,12}]],{x,-2.5,2.5},PlotRange->{-0.5 10^9,0.5 10^9}];

Work

Herleitung 1 - Déduction 1

a=2

Remove["Global`*"]

a

f[x_]:= E^(-x^2);
pl1=Plot[f[x],{x,-2.5,2.5}];

r=0.4

Range[-2,2,r]

k=10

z[n_,k_]:=-2+n 4/k; z[2,k]

p[n_,k_]:=Point[{z[n,k],f[z[n,k]]}];
ta[k_]:=Table[p[n,k],{n,0,k}];
ta[k]

?Show

Show[pl1,Graphics[{PointSize[0.03],ta[k]}]];

q[a_+b_]:=q[a]+q[b];
q[7+8]

q[7+a]

q[a+b+c]

Log[a_+b_]:=Log[a]+Log[b];
Log[a+b]

?Protect

Unprotect[q];
q[a_+b_]:=q[a]+q[b];
q[a_ b_]:=q[a] q[b];
q[x_]:=x

q[a+b+c+d]

q[a b +c d+ e]

q[d f+ k j j + l x+ t]

?Plus

li=Table[a[n] x^n,{n,0,k}]

Plus@@li

q[Plus@@li]

q[Plus@@li]/. x->m

q[Plus@@li]/. x->22

taGl[k_]:=Table[(q[Plus@@li]/. x->z[n,k])==f[z[n,k]],{n,0,k}];
taGl[k]

solv[k_]:= Solve[taGl[k],Table[a[n],{n,0,k}]]// Flatten;
solv[k]

q[Plus@@li]

g[h_] := 
        q[Plus @@ li] /. 
          Union[solv[k], {x -> h}];
g[u]

g[20]

Plot[g[x],{x,-3,3}];

pl2=Plot[g[x],{x,-2.2,2.2},AspectRatio->Automatic];

pl1=Plot[f[x],{x,-2.2,2.2},AspectRatio->Automatic];

Show[pl1,pl2,Graphics[{PointSize[0.03],ta[k]}]];

Herleitung 2 - Déduction 2

Remove["Global`*"]

f[x_]:=1/(x^2+1);  f[x]

?Range

ra = Range[11]-6

ra[[4]]

Table[ra[[k]],{k,1,7}]

?Prepend

list1 = Prepend[Table[Point[{ra[[k]],f[ra[[k]]]}],{k,1,Length[ra]}],   PointSize[0.02]]

Plot[f[x],{x,-5.1,5.1},Epilog->list1];

Polynom fix definiert - Polynôme défini de façon fixe

pol1[x_,a10_,a9_,a8_,a7_,a6_,a5_,a4_,a3_,a2_,a1_,a0_]:=
a10 x^10+a9 x^9 +a8 x^8+a7 x^7+ a6 x^6+ a5 x^5+ a4  x^4+ a3 x^3+a2 x^2+a1 x^1+a0;

pol1[x,a10,a9,a8,a7,a6,a5,a4,a3,a2,a1,a0]

eq1[k_]:= (f[ra[[k]]]== pol1[ra[[k]],a10,a9,a8,a7,a6,a5,a4,a3,a2,a1,a0])

Table[eq1[k],{k,1,Length[ra]}]

solv1 = Solve[Table[eq1[k],{k,1,Length[ra]}],{a10,a9,a8,a7,a6,a5,a4,a3,a2,a1,a0}]// Flatten

pol1[x_]:=
a10 x^10+a9 x^9 +a8 x^8+a7 x^7+ a6 x^6+ a5 x^5+ a4  x^4+ a3 x^3+a2 x^2+a1 x^1+a0 /.  solv1 ;  pol1[x]

Plot[{f[x], pol1[x] },{x,-5.1,5.1},Epilog->list1];

Plot[{pol1[x] },{x,-5.1,5.1},Epilog->list1];

Polynom variabel definiert - Polynôme défini de façon variable

pol2[x_,n_]:= b[0]+Sum[b[k] x^k,{k,1,n-1}] ;  pol2[x,11]

eq2[k_,n_]:= (f[Evaluate[ra[[k]]]]== pol2[Evaluate[ra[[k]]],n]);  eq2[3,Length[ra]]

eq2[1,Length[ra]]

(f[Evaluate[ra[[4]]]]== pol2[Evaluate[ra[[4]]],Length[ra]])

eq2[4,Length[ra]]

eq2[6,Length[ra]]

eq2[ra[[-5]],Length[ra]]

Table[eq2[k,Length[ra]],{k,1,Length[ra]}]

Table[eq2[k,11],{k,1,Length[ra]}]

solv2 = Solve[Table[eq2[k,Length[ra]],{k,1,Length[ra]}],Table[b[k],{k,0,Length[ra]-1}]]// Flatten

pol2[x_,n_]:= b[0]+Sum[b[k] x^k,{k,1,n}]/.solv2 ;  pol2[x,Length[ra]-1]

Plot[{pol2[x,Length[ra]-1] },{x,-5.1,5.1},Epilog->list1];

Plot[{pol1[x], pol2[x,Length[ra]-1] },{x,-5.1,5.1},Epilog->list1];

Training 1

Remove["Global`*"]

ra=Range[10];
x=Table[u[k],{k,1,Length[ra]}];
f[x_List]:=Sum[ra[[k]] x[[k]]^k,{k,1,Length[ra]}]

f[x]

Remove["Global`*"]

ra=Range[10];
aa=Table[a[k],{k,1,Length[ra]}];
f[x_,aa_List]:=Sum[aa[[k]]  x^k,{k,1,Length[ra]}];
f[x,aa]

ra=Range[20];
aa=Table[a[k],{k,1,Length[ra]}];
f[x_,aa_List]:=Sum[aa[[k]]  x^k,{k,1,Length[ra]}];
f[x,aa]

Training 2

Remove["Global`*"]

fF1[x_] := Map[Sin, x];  fF1[{a, b, c}]

fF2[x_] := Apply[Sin, x];  fF2[{a, b, c}]

fF2[u]

New @@ Old[a, b, c]

New @@ Sin[a]

Sin @@ Cos[a]

Apply[New, Old[a, b, c]]

Apply[Sin, Cos[r]]

Apply[Sin, r]

Apply[Sin, {r}]

Apply[Sin, Times[a, b]]

Apply[Sin, Times[a  b]]

Apply[Sin, Times[{a  b}]]

f1[fkt_, x_] := Apply[fkt, {x}];   f1[Sin, x]

hFkt1[x_] := f1[Sin, x];  hFkt1[0]

?Apply

?Map

Work, Trials

li1=Union[Table[a[n]_,{n,0,10}],{x_}]

Unprotect[li1,p]

p[li1]:=Plus@@li; 
p[li1]

p[{x,1,2,3,4,5,6,7,8,9,10,11}]

?Protect

li2=Union[Table[a[n],{n,0,10}],{x}]

p[li2]

p[{x,1,2,3,4,5,6,7,8,9,10,11}]

Programm with printouts

Remove["Global`*"]

(* ====================> Module *)

fnPlot[expr_,k_,xU_,xO_,pSize_,over_]:=
    Module[{f,fkt,pl1,n,p,z,ta,kInt,q,aa,bb,li,taGl,solv,pl2,pl3,a,x,g,h,sh},
      
      fkt[f_,x_]:=Apply[f,{x}];
      (* pl1=Plot[fkt[expr,x],{x,xU,xO}]; *)
      z[n_,kInt_]:=xU+n *(xO-xU)/kInt;
      p[n_,kInt_]:=Point[{z[n,kInt],fkt[expr,z[n,kInt]] }];
      ta[kInt_]:=Table[p[n,kInt],{n,0,kInt}];
      pl2=Plot[fkt[expr,x],{x,xU-(xO-xU)/k/2,xO+(xO-xU)/k/2},Epilog->{PointSize[pSize],ta[k]},DisplayFunction->Identity]; 
      q[aa_+bb_]:=q[aa]+q[bb];
      q[aa_+bb_]:=q[aa]+q[bb];
      q[aa_ bb_]:=q[aa] q[bb];
      q[x_]:=x;
      Unprotect[q];
      li=Table[a[n] x^n,{n,0,k}];
      taGl[kInt_]:=Table[(q[Plus@@li]/.x->z[n,kInt])==fkt[expr,z[n,kInt]],{n,0,kInt}];
      solv[kInt_]:=Solve[taGl[kInt],Table[a[n],{n,0,kInt}]]//Flatten;
      g[h_,kInt_]:=q[Plus@@li]/.Union[solv[kInt],{x->h}];
      pl3=Plot[g[x,k],{x,xU-(xO-xU)/k/2,xO+(xO-xU)/k/2},AspectRatio->Automatic,DisplayFunction->Identity];
      sh=Show[pl2,pl3,DisplayFunction->$DisplayFunction];
      pl4=Plot[g[x,k],{x,xU-over(xO-xU)/k,xO+over(xO-xU)/k}];
      Print[" ........................................................"];
      Print[" Kontrolle:"];
      Print[" Contrôle:"];
      Print[" Kontrolle:"];
      Print[" Contrôle:"];
      Print[" Kontrolle:"];
      Print[" Contrôle:"];
      Print[" ........................................................"];
      Print["Polynome[v] =  ",g[v,k]//N,   " ===> Look at the coefficients!"];
                                         Print[" New Line 1"];
      Print[ {xU,xO,{xU,xO}}];           Print[" New Line 2"];
      Print[ k, pSize, expr[kGlob]];           Print[" New Line 3"];
      Print[fkt[expr,xx]];                     Print[" New Line 4"]; 
      Print[pl2];                                           Print[" New Line 5"];
      Print[z[5,9]];                                   Print[" New Line 6"]; 
      Print[p[5,9]];                                   Print[" New Line 7"];
      Print[ta[9]];                                  Print[" New Line 8"];
      Show[pl2,Graphics[{PointSize[pSize],ta[k]}]]; Print[" New Line 9"]; 
      Print[li];                           Print[" New Line 10"];
      Print[taGl[k]];               Print[" New Line 11"];
      Print[solv[k]];               Print[" New Line 12"];
      Print[g[x,k]];                Print[" New Line 13"];
      Print[pl2];                        Print[" New Line 14"];
      Print[sh];                          Print[" New Line 15"];
      ];

(* ====================> Data4 *)

expr[x_]:=Sin[x];
k=10;
{xU,xO}={-10,10};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=2;

(* ====================> Plot4 *)

fnPlot[expr,k,xU,xO,pSize,over];

(* ====================> Data5 *)

expr[x_]:=Sin[x];
k=12;
{xU,xO}={-10,10};  (* Print[ {xU,xO,{xU,xO}}];  *)
pSize=0.03;
over=2;

(* ====================> Plot5 *)

fnPlot[expr,k,xU,xO,pSize,over];

Fit (Beispiele / Exemples)

Beispiel / Ex. 1

Remove["Global`*"]

points = {{0, -1}, {1, 2}, {3, 7}, {4, 6}, {7, 9}, {11, 
            14}};

plotpoints = 
        ListPlot[points, PlotStyle -> PointSize[0.02]];

Fit[points, x, x]

plotline = Plot[%, {x, -3, 14}];

%% /. x -> 0

Fit[points, x + 2, x]

plotline = Plot[%, {x, -3, 14}];

%% /. x -> 0

Fit[points, x + 10, x]

plotline = Plot[%, {x, -3, 14}];

%% /. x -> 0

Show[plotpoints, plotline];

Fit[points, {x, 1}, x]

plotline = Plot[%, {x, -3, 14}];

%% /. x -> 0

Show[plotpoints, plotline];

Beispiel / Ex. 2

Remove["Global`*"]

?DivisorSigma

DivisorSigma[k, n]gives the divisor function(Subscript[σ, k])(n). (Subscript[σ, k])(n)is the sum of thek(^th)powers of the divisors ofn.

DivisorSigma[0, 120]

FactorInteger[120]

Binomial[5, 4]

Sum[Binomial[5, k], {k, 1, 5}]

divisorsigma2table = Table[DivisorSigma[2, x], {x, 20}]

plotdivisorsigma2 = 
        ListPlot[divisorsigma2table, 
          PlotStyle -> PointSize[0.02]];

linearfit = Fit[divisorsigma2table, {1, x}, x]

plotpoints = 
        ListPlot[
          Table[divisorsigma2table[[k]], {k, 1, 
              Length[divisorsigma2table]}], 
          PlotStyle -> PointSize[0.02]];

plotline = Plot[%%, {x, -3, 20}]; 
    Show[plotpoints, plotline];

quadraticfit = Fit[divisorsigma2table, {1, x, (x^2)}, x]

plotline = Plot[%, {x, -3, 20}]; 
    Show[plotpoints, plotline];

cubicfit = Fit[divisorsigma2table, {1, x, (x^2), (x^3)}, x]

plotline = Plot[%, {x, -3, 20}]; 
    Show[plotpoints, plotline];

cubicfit = Fit[divisorsigma2table, {1, x, Sin[x]}, x]

plotline = Plot[%, {x, -3, 20}]; 
    Show[plotpoints, plotline];