(*            Interpolation:                                                                                                       *)

Off[General::spell]  ;      Off[
      General::spell1]

lauf = 1;                         (*  Lauf mit der Nummer lauf  ,  
          alle vorhergehenden Läufe bleiben erhalten ! *)

\( (*\ \ Vorgeben\ \(("V")\)\ der\ m + 
            1\ Stützpunkte\ , 
\ \ \ \ \ \ \ Löschen\ \((" L ")\)\ , \ \ Einfügen\ \((" E ")\)\ \ oder\ \ Ändern\ \((" K")\)\ eines\ Punktes\ \ ?\ \ \ \ \ nichts\ Ändern\ \ \((" N ")\)\ \ \ \ \ \ *) \)

sch =  "V";

If[sch == "N", 
      If[index ≥ 0 And index ≤ 
          m  ,    
TableForm[
          Table[{ind = PaddedForm[i, 2], "     xp[", ind, "] = ", 
              PaddedForm[xp[i], {3, 2}], 
"    yp[", 
              ind, "] = ", PaddedForm[yp[i], {3, 2}]}, {i, 0, m}], 
          TableSpacing -> {1, 0}]]]

(*  Stützpunkte 0,  .. , m  eingeben        *)

\(\(If[\ 
        sch == "V", {\ \ m = 10, 
\ 
          xp[0] = \(-4. \); \ \ \ yp[0] = 
            0. ; \ \ \ xp[1] = \(-3.95\); \ \ \ \ \ yp[1] = 
            0.5; \ \ \ \ \ \ xp[2] = \(-3.5\); \ \ \ \ \ \ yp[2] = 
            1.5; \ \ \ \ \ \ \ xp[3] = \(-3. \); \ \ \ yp[3] = 
            2. ; \ \ \ xp[4] = \ \(-2\); \ \ \ \ \ \ \ \ \ \ yp[4] = 
            2.6; \ \ \ \ \ \ xp[5] = \ \(-1\); \ \ \ \ \ \ \ \ \ yp[5] = 
            2.9; \ \ \ \ \ \ \ \ \ xp[6] = \ \ \ 0. ; \ \ \ yp[6] = 
            3. ; \ \ xp[7] = \ \ \ 2; \ \ \ \ \ \ \ \ \ \ \ yp[7] = 
            2.6; \ \ \ \ \ \ \ xp[8] = \(+3. \); \ \ \ \ \ \ \ \ yp[8] = 
            2. ; 
\ \ \ \ \ \ \ \ xp[9] = \ 3.75; \ 
          yp[9] = 1; \ \ \ \ xp[10] = \(+4. \); \ \ \ \ \ \ yp[10] = 
            0. ;\ \ \ }\ \ \ \ ];\)\)

(*  Vorgegebene Stützpunkte 0,  .. , m       *)

If[sch == "V", 
      TableForm[
        Table[{ind = PaddedForm[i, 2], "     xp[", ind, "] = ", 
            PaddedForm[xp[i], {3, 2}], "    yp[", ind, "] = ", 
            PaddedForm[yp[i], {3, 2}]}, {i, 0, m}], 
        TableSpacing -> {1, 0}]]

index  =  1 ;                  
  \(If[sch == "L", 
          If[index ≥ 0\ And\ index ≤ 
              m\ , {m = 
                m - 1; 
\ \ \ \ \ \ \ \ \ Do[{\ xp[j] = xp[j + 1], 
                  yp[j] = yp[j + 1]}, {j, index, m}]}]]\);

(*   Stützpunkte   0,..,m ,  nach dem Entfernen von Punkten    *)

If[sch == "L", 
      If[index ≥ 0 And index ≤ 
          m  ,    
TableForm[
          Table[{ind = PaddedForm[i, 2], "     xp[", ind, "] = ", 
              PaddedForm[xp[i], {3, 2}], 
"    yp[", 
              ind, "] = ", PaddedForm[yp[i], {3, 2}]}, {i, 0, m}], 
          TableSpacing -> {1, 0}]]]

index  =  2 ;                  
If[sch == "E",If[index ≥ 0 And index ≤ m,{m = m + 1;Do[{xp[j], yp[j]}, {j, 0, index - 1}];
   Do[{xp[j] = xp[j - 1], yp[j] = yp[j - 1]}, {j, 
                        m, index + 1, -1}];
       xp[index] =   3.75                                         ;
        yp[index] =    1.0                                       }]];

(*   Stützpunkte   0,..,m ,  nach dem Einfügen von Punkten    *)

If[sch == "E", 
      If[index ≥ 0 And index ≤ 
          m,    
TableForm[
          Table[{ind = PaddedForm[i, 2], "     xp[", ind, "] = ", 
              PaddedForm[xp[i], {3, 2}], 
"    yp[", 
              ind, "] = ", PaddedForm[yp[i], {3, 2}]}, {i, 0, m}], 
          TableSpacing -> {1, 0}]]]

index  =   2;                  
    If[sch == "K",If[index ≥ 0 And index ≤ m,{       xp[index] =    -3.75                                         ;
        yp[index] =    1.0                                       }]];

(*   Stützpunkte   0,..,m ,  nach dem Einfügen von Punkten    *)

If[sch == "K", 
      If[index ≥ 0 And index ≤ 
          m,    
TableForm[
          Table[{ind = PaddedForm[i, 2], "     xp[", ind, "] = ", 
              PaddedForm[xp[i], {3, 2}], 
"    yp[", 
              ind, "] = ", PaddedForm[yp[i], {3, 2}]}, {i, 0, m}], 
          TableSpacing -> {1, 0}]]]

nummer[lauf] = m;

nd = 400;

Do[{xel[j] = xp[0] + j*(xp[m] - xp[0])/nd, 
        yel[j] = 3/4*Sqrt[16 - xel[j]^2]}, {j, 0, nd}]

<< Graphics`Colors`

liste1 = {Red, HotPink, Green, Apricot, Brown, DarkGreen, Cobalt, 
          Brick, Orange, Magenta, IndianRed, ForestGreen};

\(ellipsplot = 
      ListPlot[Table[{xel[j], yel[j]}, {j, 0, nd}], 
        PlotJoined\  -> \ True, 
	
        PlotRange -> {{\(-5\), 5}, {\(-1\), 4}}, 	PlotStyle -> Brown, 
        AspectRatio -> 0.5, AxesLabel -> {"> x", "  ^ y"}]\)

\(linienplot = 
      ListPlot[Table[{xp[k], yp[k]}, {k, 0, m}], PlotJoined\  -> \ True, 	
        PlotRange -> {{\(-5\), 5}, {\(-1\), 4}}, 
	PlotStyle -> Blue, 
        AspectRatio -> 0.5, AxesLabel -> {"> x", "  ^ y"}]\)

\(punktplot = 
      ListPlot[Table[{xp[k], yp[k]}, {k, 0, m}], PlotJoined\  -> \ False, 	
        PlotRange -> {{\(-5\), 5}, {\(-1\), 4}}, 
	PlotStyle -> Blue, 
        Prolog\  -> \ AbsolutePointSize[5], AspectRatio -> 0.5, 
        AxesLabel -> {"> x", "  ^ y"}]\)

Show[ellipsplot, linienplot, punktplot, 
      Prolog  ->  AbsolutePointSize[5]]

Do[DivDiff[k, 1] = (yp[k + 1] - yp[k])/(xp[k + 1] - xp[k]), {k, 
        0, m - 1}]

Do[Do[
        DivDiff[k, 
            j] = (DivDiff[k + 1, j - 1] - 
                DivDiff[k, j - 1])/(xp[k + j] - xp[k]), {k, 0, 
          m - j}], {j, 2, m}]

\(Do[{xnew[j] = xel[j], ynew[j] = yp[0], 
        pro = xel[j] - 
            xp[0], 
		Do[{ynew[j] = ynew[j] + pro*DivDiff[0, i], 
            pro = pro*\((xnew[j] - xp[i])\)}, {i, 1, m}]}, {j, 0, 
        nd}]\)

\(newtonplot = 
      ListPlot[Table[{xnew[j], ynew[j]}, {j, 0, nd}], 
        PlotJoined\  -> \ True, 
	
        PlotRange -> {{\(-5\), 5}, {\(-1\), 4}}, 	PlotStyle -> Red, 
        AspectRatio -> 0.5, AxesLabel -> {"> x", "  ^ y"}]\)

(*      Natürliche Spline - 
            Interpolation                         *)

Du[0] = xp[1] - xp[0];
Do[{Du[k] = xp[k + 1] - xp[k], Dh[k] = 2 (Du[k - 1] + Du[k])}, {k, 
        1, m - 1}]

Ch[1] = Sqrt[Dh[1]];
Do[{Cn[k - 1] = Du[k - 1]/Ch[k - 1], 
        Ch[k] = Sqrt[Dh[k] - Cn[k - 1]^2]}, {k, 2, m - 1}]

\(\( (*\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Vorwärtsrechnung\ "von oben her"\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ *) \)\(
\)\( (*\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 	und\ Erstellen\ der\ rechten\ Seite\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ *) \)\)

Dv[0] = yp[1] - yp[0];        Dv[1] = yp[2] - yp[1];
Dr[1] = 3 (Dv[1]/Du[1] - Dv[0]/Du[0]);
Z[1] = Dr[1]/Ch[1];
\(Do[{Dv[k] = yp[k + 1] - yp[k], 
		Dr[k] = 
          3 \((Dv[k]/Du[k] - Dv[k - 1]/Du[k - 1])\), 
		Z[
            k] = \((Dr[k] - Z[k - 1]*Cn[k - 1])\)/Ch[k]}, 
{k, 2, 
        m - 1}]\)

\(\( (*\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Rückwärtsrechnung\ "von unten her"\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ *) \)\(
\)\( (*\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 	Berechnung\ der\ Koeffizienten\ B\_k\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ *) \)\)

B[m] = 0;   B[m - 1] = Z[m - 1]/Ch[m - 1];
Do[B[k] = (Z[k] - B[k + 1]*Cn[k])/Ch[k], {k, m - 2, 1, -1}];  
    B[0] = 0;

\(Do[{A[
            k] = \((B[k + 1] - B[k])\)/\((3 
                 Du[k])\), 
		\ \ \ \ \ \ \ \ \ \ \ \ \ Cc[k] = 
          Dv[k]/Du[k] - Du[k]*\((B[k + 1] + 2  B[k])\)/3, \ 
        Dc[k] = yp[k]}, {k, 0, m - 1}]\)

\(Do[{xnat[j] = xel[j], 
        xint = xp[0], 
		Do[{Dnt[k] = xp[k + 1] - xp[k], 
            If[\((xnat[j] >= xint\ )\)\  ∧ \ \ \((xnat[j] <= 
                    xint + Dnt[k]\ )\), {knt = k, Break[]}\ , 
              xint = xint + Dnt[k]]}, {k, 0, m - 1}], 
		Dntmj = 
          xnat[j] - xp[knt], 
						ynat[j] = 
          A[knt]*Dntmj^3 + B[knt]*Dntmj^2 + Cc[knt]*Dntmj + 
            Dc[knt]\ }, 
	{j, 0, nd}]\)

\(natsplplot = 
      ListPlot[Table[{xnat[j], ynat[j]}, {j, 0, nd}], 
        PlotJoined\  -> \ True, 
	
        PlotRange -> {{\(-5\), 5}, {\(-1\), 4}}, 	PlotStyle -> Green, 
        AspectRatio -> 0.5, AxesLabel -> {"> x", "  ^ y"}]\)

graf[lauf] = 
      Show[natsplplot, newtonplot, ellipsplot, linienplot, punktplot, 
        Prolog  ->  AbsolutePointSize[5]]

Do[{Print["       Lauf Nummer ", l , " mit ", 
          nummer[l], " Stützpunkten " ], Show[graf[l]]}, {l, 
        1, lauf}]