Lösungen / Solutions

1

Fixpunkt System / Emboîtement système

Remove["Global`*"]

f1[x_,y_]:=Sin[x+y];  (* f[x,y] + x = f1[x,y] *)
g1[x_,y_]:=Cos[x-y];  (* g[x,y] + x = g1[x,y] *)

a[1]=0; b[1]=0; a[0]=0; b[0]=0;
a1[n_]:=f1[a[n-1],b[n-1]];
b1[n_]:=g1[a[n-1],b[n-1]];
a[n]

a1[1]

?Do

Do[a[n]=a1[n]//N;b[n]=b1[n]//N;Print[{n, a[n],b[n]}],{n,2,14}]

2

Remove["Global`*"]

f[x_,a0_,a1_,a2_,a3_,a4_,a5_,a6_]:=a6 x^6+ a5 x^5+ a4 x^4 + a3 x^3 + a2 x^2 + a1 x + a0;

s=-5;

solv = Solve[
{f[0,a0,a1,a2,a3,a4,a5,a6]==0,
f[1,a0,a1,a2,a3,a4,a5,a6]== 1,
f[2,a0,a1,a2,a3,a4,a5,a6]== 2,
f[3,a0,a1,a2,a3,a4,a5,a6]== 3,
f[4,a0,a1,a2,a3,a4,a5,a6]== s,
f[5,a0,a1,a2,a3,a4,a5,a6]== 5,
f[6,a0,a1,a2,a3,a4,a5,a6]== 6},{a0,a1,a2,a3,a4,a5,a6}] // Flatten;
f[x_,a0_,a1_,a2_,a3_,a4_,a5_,a6_]:=a6 x^6+ a5 x^5+ a4 x^4 + a3 x^3 + a2 x^2 + a1 x + a0 /. solv;
Print[f[x,a0,a1,a2,a3,a4,a5,a6]];
Plot[{x,f[x,a0,a1,a2,a3,a4,a5,a6]},{x,-1,7},Epilog->{PointSize[0.03],Point[{0,0}],Point[{1,1}],Point[{2,2}],Point[{3,3}],Point[{4,s}],Point[{5,5}],Point[{6,6}]}];

f[x_,a0_,a1_,a2_,a3_,a4_,a5_,a6_]:=a6 x^6+ a5 x^5+ a4 x^4 + a3 x^3 + a2 x^2 + a1 x + a0;
s=-5;
solv = Solve[
{f[0,a0,a1,a2,a3,a4,a5,a6]==0,
f[1,a0,a1,a2,a3,a4,a5,a6]== 1,
f[2,a0,a1,a2,a3,a4,a5,a6]== 2,
f[3,a0,a1,a2,a3,a4,a5,a6]== 3,
f[4,a0,a1,a2,a3,a4,a5,a6]== s,
f[5,a0,a1,a2,a3,a4,a5,a6]== 5,
f[6,a0,a1,a2,a3,a4,a5,a6]== 6},{a0,a1,a2,a3,a4,a5,a6}] // Flatten;

f[x_,a0_,a1_,a2_,a3_,a4_,a5_,a6_]:=a6 x^6+ a5 x^5+ a4 x^4 + a3 x^3 + a2 x^2 + a1 x + a0 /. solv;
f[x_]:=f[x,a0,a1,a2,a3,a4,a5,a6];Print[f[x,a0,a1,a2,a3,a4,a5,a6]];
f[x];

Plot[{x,f[x,a0,a1,a2,a3,a4,a5,a6]},{x,-1,7},
Epilog->{PointSize[0.03],Point[{0,0}],Point[{1,1}],Point[{2,2}],Point[{3,3}],Point[{4,s}],Point[{5,5}],Point[{6,6}]}];

p[1]={0,0};p[2]={1,1};p[3]={2,2};p[4]={3,3};p[5]={4,-5};p[6]={5,5};p[7]={6,6};

δ[
          k_] := (p[k + 1][[2]] - p[k][[2]])/(p[
                  k + 1][[1]] - p[
                  k][[1]]);
tabδ1 = Table[δ[k], {k, 1, 6}]

h[x_]:= tabδ1[[Floor[x]+1]];

Plot[h[x],{x,0,6}];

pol[x_]:= f[x,a0,a1,a2,a3,a4,a5,a6]

pol1[x_]:= Evaluate[D[pol[y],y]]/.y->x

Plot[{pol1[x]},{x,0,6}];

Plot[{pol[x], pol1[x]},{x,0,6}];

Plot[{pol1[x],h[x]},{x,0,6}];

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

ρ[x_]:=pol1[Floor[x]+0.5];

tabρ1=Table[{Floor[k-1]+0.5,ρ[k-1]},{k,1,6}]

tabρ1=Table[{Floor[k-1]+0.5,pol1[Floor[k-1]+0.5]},{k,1,6}]

Plot[{pol[x],ρ[x]},{x,0,6},
Epilog->{PointSize[0.03],Point[{0.5,pol[0.5]}],Point[{1.5,pol[1.5]}],Point[{2.5,pol[2.5]}],Point[{3.5,pol[3.5]}],Point[{4.5,pol[4.5]}],Point[{5.5,pol[5.5]}]}];

Plot[{pol1[x],ρ[x]},{x,0,6},
Epilog->{PointSize[0.03],Point[{0.5,pol1[0.5]}],Point[{1.5,pol1[1.5]}],Point[{2.5,pol1[2.5]}],Point[{3.5,pol1[3.5]}],Point[{4.5,pol1[4.5]}],Point[{5.5,pol1[5.5]}]}];

Plot[{pol[x],pol1[x],h[x],ρ[x]},{x,0,6}];

Plot[{h[x],ρ[x]},{x,0,6}];

3

Remove["Global`*"]

f1[x_]:= 1 + Sum[(x (- Sin[k Pi/8]))^k,{k,1,1000}];
f1[x]

f1[0.999]

f1[x_]:= 1 + Sum[(-x Sin[k Pi/8])^k,{k,1,100000}];
f1[0.999]

?Do

Remove["Global`*"]

f1[x_]:= 1+ Sum[x^k (-Sin[k Pi/8])^k,{k,1,1000}];

x = 0.999
f2 = (-Sin[(1000) Pi/8])^1000;

u = Do[
Print[f2];
h = f2 x + (-Sin[(1000-k) Pi/8])^(1000-k)  ;Print[h]; 
f2 = h,
{k,1,999}];
Print[u1=f2*x+1];
Print[" "];
Print["Vergleich Comparer f1[0.999]   ",u2=f1[x] ];
Print["f1[0.999]:    ", Timing[f1[0.999];]];
Print["Abweichung - Difference  Abs(u1-u2)  ", Abs[u1-u2]];

4

Script: Studium / Etudes

5

a Lagrange:

Remove["Global`*"]

p[1]={0,0};p[2]={1,1};p[3]={2,2};p[4]={3,3};p[5]={4,-5};p[6]={5,5};p[7]={6,6};

?Product

lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,7}];
Table[lag[k,x],{k,1,7}]

Table[lag[k,x],{k,1,7}]//Expand

pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,7}]//Expand;
pol[x]

pol[2.5]

Plot[{x,pol[x]},{x,-1,7},Epilog->{PointSize[0.03],Point[p[1]],Point[p[2]],Point[p[3]],Point[p[4]],Point[p[5]],Point[p[6]],Point[p[7]]}];

Plot[{x,pol[x]},{x,-1,7},Epilog->{PointSize[0.03],Point[p[1]],Point[p[2]],Point[p[3]],Point[p[4]],Point[p[5]],Point[p[6]],Point[p[7]]},PlotRange->All];

b Lagrange:

Remove["Global`*"];
f[x_]:=1/(x^2+1); 
m=4;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Time!!

Remove["Global`*"];
f[x_]:=1/(x^2+1); 
m=9;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Remove["Global`*"];
f[x_]:=1/(x^2+1); 
m=10;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

c Lagrange:

Remove["Global`*"];
f[x_]:=1/(x^3+1); 
m=4;
px[m_]:=Table[0+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,0,10},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Time!!

Remove["Global`*"];
f[x_]:=1/(x^3+1); 
m=9;
px[m_]:=Table[0+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,0,10},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Remove["Global`*"];
f[x_]:=1/(x^3+1); 
m=10;
px[m_]:=Table[0+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,0,10},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

d Lagrange:

Remove["Global`*"];
f[x_]:=1/(x^4+1); 
m=4;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Time!!

Remove["Global`*"];
f[x_]:=1/(x^4+1); 
m=9;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

Remove["Global`*"];
f[x_]:=1/(x^4+1); 
m=10;
px[m_]:=Table[-5+10*k/m,{k,0,m}];
p[k_]:={px[m][[k]],f[px[m][[k]]]};
lag[k_,x_]:= Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,1,k-1}]* Product[(x-p[n][[1]])/(p[k][[1]]-p[n][[1]]),{n,k+1,m}];
pol[x_]:= Sum[p[k][[2]]*lag[k,x],{k,1,m}]//Expand;
Plot[ pol[x] ,{x,-5,5},Epilog->Prepend[Table[Point[p[k]],{k,1,m}], PointSize[0.03]]];

6

Script: Studium / Etudes