Lösungen

Lösung zu Aufgabe 1

a

f[x_,y_]:= Sqrt[x^2+y^2] E^(-Sqrt[x^2+y^2]/2);
Plot3D[f[x,y],{x,-2,2},{y,-2,2}];

Plot3D[f[x,y],{x,-2,2},{y,-2,2},ViewPoint->{3.667, 2.785, -1.120},PlotRange->{0,1}];

Plot3D[f[x,y],{x,-20,20},{y,-20,20},ViewPoint->{3.667, 2.785, -1.120},PlotRange->{0,1}];

h[r_]:= r E^(-r/2);
ParametricPlot3D[{r Cos[t],r Sin[t], h[r]}, {r,0,3}, {t,0,2Pi}, ViewPoint->{3.667, 2.785, -1.120}, AspectRatio->1];

ParametricPlot3D[{r Cos[t],r Sin[t], h[r]}, {r,0,2}, {t,0,2Pi}, AspectRatio->1];

b

D[f[x,y],x]/.x->u

Plot[Evaluate[D[f[x,0],x]/.x->u],{u,-3,3}];

Limit[Evaluate[D[f[x,0],x]/.x->u],u->0, Direction -> 1]

Limit[Evaluate[D[f[x,0],x]/.x->u],u->0, Direction -> -1]

c

Plot[h[r],{r,0,3}];

D[h[r],r]/.r->2

hMax=h[2]

hMax=h[2]//N

d

<<Calculus`VectorAnalysis`

Drop[Grad[f[x,y], Cartesian[x, y, z]],{3}]

Drop[Grad[f[x,y], Cartesian[x, y, z]],{3}] /. {x->1,y->1}

N[%]

e

Oberfl= Integrate[Evaluate[Sqrt[D[f[x,y],x]^2+D[f[x,y],x]^2+1]/.{x->x1,y->y1}],{x1,1,2},{y1,1,2}]

NIntegrate[Evaluate[Sqrt[D[f[x,y],x]^2+D[f[x,y],x]^2+1]/.{x->x1,y->y1}],{x1,1,2},{y1,1,2}]

NIntegrate[Evaluate[Sqrt[D[f[x,y],x]^2+D[f[x,y],x]^2+1]/.{x->x1,y->y1}],{x1,0,2},{y1,1,2}]

Remove["Global`*"]

Lösung zu Aufgabe 2

a

DSolve[{y''[x]  +  2  y[x]  == Cos[x]}, y[x], x ] // 
      Simplify

N[%]

b

DSolve[{y''[x]-y'[x] + 2 y[x] ==Cos[x]},y[x],x ]//Simplify

N[%]

c

DSolve[{y''[x] - y'[x] + 2  y[x] == Cos[x], 
          y[0] == 0, y'[0] == 0}, y[x], x ] // 
      Simplify

N[%]

solv=DSolve[{y''[x]-y'[x]+2y[x]==Cos[x],y[0]==0,y'[0]==0},y,x ]//Simplify//Flatten

N[%]

y=y/.solv;
y[z]//Simplify

N[%]

d

pl=Plot[y[z],{z,0,12}];

e

FindRoot[y[x],{x,3}]

y[2.75558]

Remove["Global`*"]

Lösung zu Aufgabe 3

a

s1=Normal[Series[Sin[x],{x,0,10}]]

Plot[{s1,Sin[x]},{x,-10,10}];

s2=Normal[Series[Cos[x],{x,0,10}]]

b

Plot[s1-Sin[x],{x,-4,4},PlotRange->{-0.01,0.01}]

c

D[s1,x]

d

s1+s2

Sqrt[2] Sin[x+Pi/4]//TrigExpand

s3=Normal[Series[Sqrt[2] Sin[x+Pi/4],{x,0,10}]]

e

Plot[{Sin[x]/x,s1/x},{x,-1,1}]

f

Integrate[s1/x,x]

NIntegrate[Simplify[s1/x],{x,-1,1}]

NIntegrate[Sin[x]/x,{x,-1,1}]

Lösung zu Aufgabe 4

Remove["Global`*"]

a

tr[x_]:= (Pi+ (Pi-2 x))/2 Sin[x]; tr[x]//Simplify

Plot[Evaluate[D[tr[x],x]/.x->u],{u,0,Pi}];

FindRoot[(Evaluate[D[tr[x],x]]==0) /.x->u,{u,1}]

(Evaluate[D[tr[x],x]]) /.x->1.11283

tr[x] /.x->1.11283

Integrate[Sin[x],{x,0,Pi}]

Integrate[Sin[x],{x,0,Pi}] - (tr[x] /.x->1.11283)

b

h[α_] := 2.5 + 4 Tan[α];
g[α_] := 1/Tan[α] h[α];
laenge[α_] := Sqrt[h[α]^2+g[α]^2]

Plot[laenge[α],{α,0,Pi/2}];

D[laenge[α],α]

fr=FindRoot[(Evaluate[D[laenge[α],α]==0] /.α->u),{u,0.75}]

laenge[u] /. fr

Remove["Global`*"]

Lösung zu Aufgabe 5 
Differenzieren und integrieren

a Resultat so kurz wie möglich halten

f[x_]:=x^2+ 0.5 Sin[x];
f[x]

f'[x]

f'[x]/.x->1

ArcTan[f'[x]/.x->1]

ArcTan[f'[x]/.x->1]/Degree

f''[x]/.x->1

b Resultat so kurz wie möglich halten

f[x_]:=(((x^(3/4)-3)^3)^(1/4))^5

f[x]

D[f[x],x]//Simplify

D[f[x],x]//Expand

c Resultat so kurz wie möglich halten

f[x_]:= 4 x^2 Sin[3x^2-2]

f[x]

D[f[x],x]//Simplify

D[f[x],x]//Expand

d Resultat so kurz wie möglich halten

f[x_]:= Log[x/(1-x)] (x/(1-x))

f[x]

D[f[x],x]//Simplify

D[f[x],x]//Expand

e Resultat so kurz wie möglich halten

f[x_]:= 4 E^(-x) Cos[2-E^x]

f[x]

D[f[x],x]//Simplify

D[f[x],x]//Expand

f Resultat so kurz wie möglich halten

Remove[a]

f[x_]:= x^2+a Sin[x]+2/x

Integrate[f[x],{x,1,E^2}]

Integrate[f[x],{x,1,E^2}]//Expand

N[%]//Expand

Remove["Global`*"]

Lösung zu Aufgabe 6 
Kurven und Flächen

Gegeben sei die Kurvenschar y=x^a auf I=[0,1]

a Plot

Plot[{x^5,x^(1/5)},{x,0,1}];

b y=x^(a) soll die eingeschlossenen Fläche halbieren. Berechne a

r1=Evaluate[Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[1]][[2]];
r2=Evaluate[Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[2]][[2]];
h=(r1==r2)

Solve[h,{a}]

r1=Evaluate[Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[1]][[2]];
r2=Evaluate[ Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[2]][[2]];
h=(r1==3 r2)

Solve[h,{a}]

r1=Evaluate[Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[1]][[2]];
r2=Evaluate[ Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[2]][[2]];
h=(r1==(Sqrt[5]+1)/2 r2)

solv1=Solve[h,{a}]//Flatten

N[%]

r3=Evaluate[Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[1]][[2]];
r4=Evaluate[ Integrate[x^5-x^(a),{x,0,1}]==Integrate[x^(a)-x^(1/5),{x,0,1}]][[2]][[2]];
h=(r3==(Sqrt[5]-1)/2 r2)

N[%]

solv2=Solve[h,{a}]//Flatten

N[%]

Plot[{x^5,x^(1/5),x^1},{x,0,1}];

Plot[{x^5,x^(1/5),x^(1/2)},{x,0,1}];

Plot Goldener Schnitt

Plot[Evaluate[{x^5,x^(1/5),x^(a)/.solv1}],{x,0,1},AspectRatio->Automatic];

Plot[Evaluate[{x^5,x^(1/5),x^(a)/.solv2}],{x,0,1},AspectRatio->Automatic];

Remove["Global`*"]

Lösung zu Aufgabe 7 
Rotationskörper, Parabel

Funktion durch Parabel angenähert. Gleiche Ableitung bei -1 und Werte bei -1 und 1, Winkelabweichung bei 1?

f[x_]:=(x^2-1) E^(-x);
p[x_,a_,b_,c_]:=a x^2+b x + c

f'[x]/.x->-1

solv=Solve[Evaluate[{p[-1,a,b,c]==0, p[1,a,b,c]==0, (D[p[x,a,b,c],x]==f'[x]/.x->-1)}]]//Flatten

%//N

p[x_]:=a x^2+b x + c/.solv; p[x]

p'[x]/.x->1

f'[x]/.x->1

ArcTan[2 E]-ArcTan[2/ E] //N

(ArcTan[2 E]-ArcTan[2/ E]) /Degree//N

a Plot

Plot[{f[x],p[x]},{x,-1,1}];

Flächenverhältnis

Integrate[(x^2-1) E^(-x),x]

Integrate[(x^2-1) E^(-x),{x,-1,1}]

%//N

Integrate[p[x],x]

Integrate[p[x],{x,-1,1}]

%//N

int=Integrate[(f[x]-p[x]),{x,-1,1}]/Integrate[(p[x]),{x,-1,1}]

int//N

Integrate[(f[x]),{x,-1,1}]/Integrate[(p[x]),{x,-1,1}]

%//N

1/%//N

Wendepunkt

Evaluate[f''[x]]/.x->0

Solve[Evaluate[f''[x]==0],{x}]

Solve[Evaluate[f''[x]==0],{x}]//N

Rotationsvolunen bei Parabe, Vergleich mit Zylinder gleicher Länge, r = ? (Hat Volumen in Zylinder mit r=2 Platz?)

Pi Integrate[p[x]^2,{x,-1,1}]

%//N

Sqrt[Integrate[p[x]^2,{x,-1,1}]/2]

%//N

Plot[{f[x],p[x],-1.9851,1.9851},{x,-1,1}];

Länge der Bögen:

{f[x],p[x]}

l1=NIntegrate[Evaluate[Sqrt[1+D[p[x],x]^2]],{x,-1,1}]

l2=NIntegrate[Evaluate[Sqrt[1+D[f[x],x]^2]],{x,-1,1}]

l3=2

l1/l2

l1/l3

l2/l3

Remove["Global`*"]

Lösung zu Aufgabe 7  
Variante:  Rotationskörper, Parabel mit Punkteverwechslung

Funktion durch Parabel angenähert. Gleiche Ableitung bei -1 und Werte bei -1 und 1, Winkelabweichung bei 1?

f[x_]:=(x^2-1) E^(-x);
p[x_,a_,b_,c_]:=a x^2+b x + c

f'[x]/.x->1

solv=Solve[Evaluate[{p[-1,a,b,c]==0, p[1,a,b,c]==0, (D[p[x,a,b,c],x]==f'[x]/.x->1)}]]//Flatten

%//N

p[x_]:=a x^2+b x + c/.solv; p[x]

p'[x]/.x->1

f'[x]/.x->1

ArcTan[2 E]-ArcTan[2/ E] //N

(ArcTan[2 E]-ArcTan[2/ E]) /Degree//N

a Plot

Plot[{f[x],p[x]},{x,-1,1}];

Flächenverhältnis

Integrate[(x^2-1) E^(-x),x]

Integrate[(x^2-1) E^(-x),{x,-1,1}]

%//N

Integrate[p[x],t]

Integrate[p[x],{x,-1,1}]

%//N

int=Integrate[(f[x]-p[x]),{x,-1,1}]/Integrate[(p[x]),{x,-1,1}]

int//N

Integrate[(f[x]),{x,-1,1}]/Integrate[(p[x]),{x,-1,1}]

%//N

1/%//N

Wendepunkt

Evaluate[f''[x]]/.x->0

Solve[Evaluate[f''[x]==0],{x}]

Solve[Evaluate[f''[x]==0],{x}]//N

Rotationsvolunen bei Parabe, Vergleich mit Zylinder gleicher Länge, r = ? (Hat Volumen in Zylinder mit r=2 Platz?)

Pi Integrate[p[x]^2,{x,-1,1}]

%//N

Sqrt[Integrate[p[x]^2,{x,-1,1}]/2]

%//N

Plot[{f[x],p[x],-1.9851,1.9851},{x,-1,1}];

Länge der Bögen:

{f[x],p[x]}

l1=NIntegrate[Evaluate[Sqrt[1+D[p[x],x]^2]],{x,-1,1}]

l2=NIntegrate[Evaluate[Sqrt[1+D[f[x],x]^2]],{x,-1,1}]

l3=2

l1/l2

l1/l3

l2/l3

Remove["Global`*"]

Lösung zu Aufgabe 8 
Annäherung Hügel durch Potenzreihe

Funktion durch Parabel angenähert. Gleiche Ableitung bei -1 und Werte bei -1 und 1, Winkelabweichung bei 1?

Test

Remove["Global`*"]

q[x_,a_,b_,c_,d_,e_]:=(a x^2+b x + c)/(x^2+d x+e)

q[x,a,b,c,d,e]//TeXForm

sys={
q[-2,a,b,c,d,e]==0,
q[2,a,b,c,d,e]==0, 
q[0,a,b,c,d,e]==2,
(D[q[x,a,b,c,d,e],x]/.x->1)==-1,
(D[q[x,a,b,c,d,e],x]/.x->-1)==1}

solv=Solve[Evaluate[sys,{a,b,c,d,e}]]

q[x_]:=(a x^2+b x + c)/(x^2+d x+e)/.solv ; q[x]

Symmetrie

Remove["Global`*"]

q[x_,a_,c_,e_]:=(a x^2+ c)/(x^2+e)

sys={
q[2,a,c,e]==0,
q[0,a,c,e]==2,
(D[q[x,a,c,e],x]/.x->1)==-1}

solv=Solve[Evaluate[sys,{a,c,e}]]//Flatten

q[x_]:=(a x^2+ c)/(x^2+e)/.solv ; q[x]

q[x]//Simplify

Konvergenzbereich: Partialbruchzerlegung, Vergleich mit geometrischer Reihe!   ==> r = 1

q1[x_]:= Evaluate[q[x]//Apart]; q1[x]

Table[D[q1[x],{x,k}],{k,0,10}]//Together

Table[D[q1[x],{x,k}],{k,0,10}]/.x->1.

q1[x_]:=Evaluate[q[x]]

Plot[q1[x],{x,-2,2}];

Plot[q1[x],{x,-8,8}];

Potenzreihe, Abweichung

q2[x_]:=Normal[Series[q1[z],{z,0,10}]]/.z->x; q2[x]

q2[x_]:=Evaluate[Normal[Series[q1[x],{x,0,10}]]]; q2[x]

{q1[x],q2[x]}

{q1[5],q2[5]}//N

Plot[{q1[x],q2[x]},{x,-1,1}];

q2[x_]:=Evaluate[Normal[Series[q1[x],{x,0,20}]]]; Plot[{q1[x],q2[x]},{x,-1,1}];

q2[x_]:=Evaluate[Normal[Series[q1[x],{x,0,150}]]]; Plot[{q1[x],q2[x]},{x,-1,1}];

q2[x_]:=Evaluate[Normal[Series[q1[x],{x,0,10}]]]; d1=q2[x]/.x->0.5

d2=q[x]/.x->0.5

d2-d1

q[x]-q2[x]/.x->0.9

Remove["Global`*"]

Lösung zu Aufgabe 9 
Reihe, Maximum Geometrie

a

Normal[Series[ArcTan[x],{x,0,10}]]

4(Normal[Series[ArcTan[x],{x,0,10}]]/.x->1)//N

4(Normal[Series[ArcTan[x],{x,0,2000}]]/.x->1)//N

b

10m : 2m

Breite 10 m

Höhe: x : 2 = (x+10) : h,   l = f[x]

Solve[ x / 2 == (x+10) / h,{h}]

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

Plot[f[x],{x,0,20}];

f'[x]

Solve[Evaluate[f'[x]==0],{x}]

Solve[Evaluate[f'[x]==0],{x}]//N

(((-5))^(1/3)) // N

(((-1))^(2/3)) // N

((((-1))^(2/3)))^2 // N

((((-1))^(2/3)))^3 // N

c

tan1=49/10

weite=2/tan1 -0.7

Remove["Global`*"]

Lösung zu Aufgabe 10

a) a

f[x_]:= -2(6x^3 + 5x^2 - 6x^1 + x^0)/(-x^2+2x+1)

f'[x]//Expand

f'[x]//Simplify

f'[x]/.x->0

ArcTan[(f'[x]/.x->0)]

ArcTan[16] // N

ArcTan[(f'[x]/.x->0)]//N

Pi/ Degree//N

N[ArcTan[(f'[x]/.x->0)]]/(1 Degree)

Plot[Evaluate[f'[x]],{x,-3,3}];

Evaluate[f'[x]==0]

Solve[Evaluate[f'[x]==0],{x}]//Simplify

Solve[f'[x]==0,{x}]//N//Chop

a) c

f[x_]:= -2(6x^3 + 5x^2 - 6x^1 + x^0)/(x^2-2x+1)

f'[x]//Expand

f'[x]//Simplify

f'[x]/.x->0

ArcTan[(f'[x]/.x->0)]

ArcTan[8] // N

Pi/ Degree//N

1.44644/ Degree

Plot[Evaluate[f'[x]],{x,-3,3}];

Evaluate[f'[x]==0]

Solve[Evaluate[f'[x]==0],{x}]

Solve[f'[x]==0,{x}]//N//Chop

a) x

f[x_]:= -2(6x^3 + 5x^2 - 8x^1 + x^0)/(x^2-2x+1)+x

f'[x]//Expand

f'[x]//Simplify

f'[x]/.x->0

ArcTan[(f'[x]/.x->0)]

ArcTan[8] // N

Pi/ Degree//N

1.44644/ Degree

Plot[Evaluate[f'[x]],{x,-3,3}];

Evaluate[f'[x]==0]

Solve[Evaluate[f'[x]==0],{x}]//Simpify

Solve[f'[x]==0,{x}]//N//Chop

b) a, c

f[x_]:= Sin[x] E^(x)-Cos[E^(-x)]-(x^3)/(x+1)

f'[x]//Expand

((f'[x]//Expand)[[1]]+(f'[x]//Expand)[[2]])//Together

(f'[x]/.x->1.0)//N

f''[x]

f''[x]//Simplify

((f''[x]//Expand)[[1]]+(f''[x]//Expand)[[2]]+(f''[x]//Expand)[[3]])//Together

Limit[Evaluate[f''[x]],x->Infinity]

b) x

f[x_]:= Sin[x] E^( x)-Cos[Log[x]]-(x^3)/(x+1)

f'[x]//Expand

((f'[x]//Expand)[[1]]+(f'[x]//Expand)[[2]])//Together

(f'[x]/.x->1.0)//N

f''[x]

f''[x]//Simplify

((f''[x]//Expand)[[1]]+(f''[x]//Expand)[[2]]+(f''[x]//Expand)[[3]])//Together

Limit[Evaluate[f''[x]],x->Infinity]

Remove["Global`*"]

Lösung zu Aufgabe 11

a

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

A[x_]:=f[x] 2x/2

Plot[A[x],{x,-2,2}];

A'[x]

Plot[A'[x],{x,-2,2}];

Solve[Evaluate[A'[x]==0],{x}]

Solve[Evaluate[A'[x]==0],{x}]//N

Plot[Evaluate[A'[x]],{x,-5,5}];

FindRoot[Evaluate[A'[x]==0],{x,0.5}]

u[1]=0.5;
u[n_]:=u[n-1]-A'[u[n-1]]/A''[u[n-1]];
Table[u[n],{n,1,5}]//MatrixForm

c

f[x_]:=2 E^(-x^2)-1;
A[x_]:=f[x] 2x/2

Plot[A[x],{x,-2,2}];

A'[x]

Plot[A'[x],{x,-2,2}];

Solve[Evaluate[A'[x]==0],{x}]

Solve[Evaluate[A'[x]==0],{x}]//N

Plot[Evaluate[A'[x]],{x,-5,5}];

FindRoot[Evaluate[A'[x]==0],{x,0.5}]

u[1]=0.5;
u[n_]:=u[n-1]-A'[u[n-1]]/A''[u[n-1]];
Table[u[n],{n,1,5}]//MatrixForm

x

f[x_]:=3 E^(-x^2)-2;
A[x_]:=f[x] 2x/2

Plot[A[x],{x,-2,2}];

A'[x]

Plot[A'[x],{x,-2,2}];

Solve[Evaluate[A'[x]==0],{x}]

Solve[Evaluate[A'[x]==0],{x}]//N

Plot[Evaluate[A'[x]],{x,-5,5}];

FindRoot[Evaluate[A'[x]==0],{x,0.5}]

u[1]=0.5;
u[n_]:=u[n-1]-A'[u[n-1]]/A''[u[n-1]];
Table[u[n],{n,1,5}]//MatrixForm

Remove["Global`*"]

Lösung zu Aufgabe 12 a

a, b

f[x_]:=(x+3)(x+2)(x-4);
Plot[f[x],{x,-4,5}];

f1[x_,a_]:=a (x+3)(x+2)(x-4);
f2[x_,b_]:=x^2+b;

solv=Flatten[Solve[{f1[x,a]==f2[x,b],Evaluate[D[f1[x,a],x]==D[f2[x,b],x]]},{a,b}]]

q=solv/.x->-2

%//N

s1={-2,f1[-2]}

S2

f1[x_]:=a (x+3)(x+2)(x-4)/.q;
f2[x_]:=x^2+b/.q;
Plot[{f1[x],f2[x]},{x,-4,5}];

solv2=Flatten[Solve[{f1[x]==f2[x]},{x}]]

Evaluate[f2'[x]]

x0=x/.solv2[[3]]

%//N

f1[x0]

%//N

s2={x0,f1[x0]}

f3'

m=Evaluate[f1'[x]]/.x->s2[[1]]

f1''[x]//Simplify

solv3=Flatten[Solve[Evaluate[f1''[x]==0],{x}]]

%//N

xW=x/.solv3

sW={xW,f1[xW]}

h[x_,a1_,b1_,c1_,d1_]:= a1 x^3+b1 x^2+c1 x+d1;
solv4=Solve[{
h[s1[[1]],a1,b1,c1,d1]==s1[[2]],
h[s2[[1]],a1,b1,c1,d1]==s2[[2]],
h[sW[[1]],a1,b1,c1,d1]==sW[[2]],
Evaluate[(D[h[x,a1,b1,c1,d1],x]/.x->s1[[1]])==m]},{a1,b1,c1,d1}
]//Flatten

h[x_]:= a1 x^3+b1 x^2+c1 x+d1/.solv4;

h'[x]/.x->s1[[2]]

%//N

Plot[{f1[x],f2[x],h[x]},{x,-5,6}];

Old

m=Evaluate[f2'[x]]/.solv2[[1]]

f1''[x]//Simplify

solv3=Flatten[Solve[Evaluate[f1''[x]==0],{x}]]

h[x_]:=f2[x0]+m(x-x0);
h[-1/3]

Plot[{f1[x],f2[x],h[x]},{x,-5,4}];

f1[-1/3]

f1[x0]

%//N

s1={}

w={-1/3,f1[-1/3]}

%//N

Remove["Global`*"]

Lösung zu Aufgabe 12 c

a, b

f[x_]:=(x-3)(x-2)(x+4);
Plot[f[x],{x,-5,4}];

f1[x_,a_]:=a (x-3)(x-2)(x+4);
f2[x_,b_]:=x^2+b;

solv=Flatten[Solve[{f1[x,a]==f2[x,b],Evaluate[D[f1[x,a],x]==D[f2[x,b],x]]},{a,b}]]

q=solv/.x->2

%//N

s1={-2,f1[-2]}

S2

f1[x_]:=a (x-3)(x-2)(x+4)/.q;
f2[x_]:=x^2+b/.q;
Plot[{f1[x],f2[x]},{x,-5,4}];

solv2=Flatten[Solve[{f1[x]==f2[x]},{x}]]

Evaluate[f2'[x]]

x0=x/.solv2[[1]]

%//N

f1[x0]

%//N

s2={x0,f1[x0]}

f3'

m=Evaluate[f1'[x]]/.x->s2[[1]]

f1''[x]//Simplify

solv3=Flatten[Solve[Evaluate[f1''[x]==0],{x}]]

%//N

xW=x/.solv3

sW={xW,f1[xW]}

h[x_,a1_,b1_,c1_,d1_]:= a1 x^3+b1 x^2+c1 x+d1;
solv4=Solve[{
h[s1[[1]],a1,b1,c1,d1]==s1[[2]],
h[s2[[1]],a1,b1,c1,d1]==s2[[2]],
h[sW[[1]],a1,b1,c1,d1]==sW[[2]],
Evaluate[(D[h[x,a1,b1,c1,d1],x]/.x->s1[[1]])==m]},{a1,b1,c1,d1}
]//Flatten

h[x_]:= a1 x^3+b1 x^2+c1 x+d1/.solv4;

h'[x]/.x->s1[[2]]

%//N

Plot[{f1[x],f2[x],h[x]},{x,-5,4}];

Old

m=Evaluate[f2'[x]]/.solv2[[1]]

f1''[x]//Simplify

%//N

solv3=Flatten[Solve[Evaluate[f1''[x]==0],{x}]]

%//N

h[x_]:=f2[x0]+m(x-x0);
h[1/3]

%//N

Plot[{f1[x],f2[x],h[x]},{x,-5,4}];

f1[1/3]

%//N

s1={}

w={1/3,f1[1/3]}

%//N

Remove["Global`*"]

Lösung zu Aufgabe 12 x

a, b

f[x_]:=(x-6)(x-2)(x+4);
Plot[f[x],{x,-5,4}];

f1[x_,a_]:=a (x-3)(x-2)(x+4);
f2[x_,b_]:=x^2+b;

solv=Flatten[Solve[{f1[x,a]==f2[x,b],Evaluate[D[f1[x,a],x]==D[f2[x,b],x]]},{a,b}]]

q=solv/.x->2

%//N

s1={-2,f1[-2]}

S2

f1[x_]:=a (x-3)(x-2)(x+4)/.q;
f2[x_]:=x^2+b/.q;
Plot[{f1[x],f2[x]},{x,-5,4}];

solv2=Flatten[Solve[{f1[x]==f2[x]},{x}]]

Evaluate[f2'[x]]

x0=x/.solv2[[1]]

%//N

f1[x0]

%//N

s2={x0,f1[x0]}

f3'

m=Evaluate[f1'[x]]/.x->s2[[1]]

f1''[x]//Simplify

solv3=Flatten[Solve[Evaluate[f1''[x]==0],{x}]]

%//N

xW=x/.solv3

sW={xW,f1[xW]}

h[x_,a1_,b1_,c1_,d1_]:= a1 x^3+b1 x^2+c1 x+d1;
solv4=Solve[{
h[s1[[1]],a1,b1,c1,d1]==s1[[2]],
h[s2[[1]],a1,b1,c1,d1]==s2[[2]],
h[sW[[1]],a1,b1,c1,d1]==sW[[2]],
Evaluate[(D[h[x,a1,b1,c1,d1],x]/.x->s1[[1]])==m]},{a1,b1,c1,d1}
]//Flatten

h[x_]:= a1 x^3+b1 x^2+c1 x+d1/.solv4;

h'[x]/.x->s1[[2]]

%//N

Plot[{f1[x],f2[x],h[x]},{x,-5,4}];

Remove["Global`*"]

Lösung zu Aufgabe 13 
Hyperbel

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

f[x_,y_,a_,c_,d_,e_]:=a x^2+c y^2+d x+e y + 1;

tab1=Table[f[p[k][[1]],p[k][[2]],a,c,d,e]==0,{k,1,4}]

solv1=Flatten[Solve[tab1,{a,c,d,e}]]

f[x_,y_,a_,c_,d_,e_]:=a x^2+c y^2+d x+e y + 1/.solv1;

f[x_,y_]:=f[x,y,a,c,d,e];
f[x,y]

solv2=Flatten[Solve[f[x,y]==0,{y}]]

graf1[x_]:=y/.solv2[[1]];  pl1= Plot[Evaluate[graf1[x]],{x,-3,4}];

graf2[x_]:=y/.solv2[[2]];  pl2= Plot[Evaluate[graf2[x]],{x,-3,4}];

Show[pl1,pl2];

Remove["Global`*"]

Lösung zu Aufgabe 13 
Ellipse a

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

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+ b x y+c y^2+d x+e y+ 1;

tab1=Table[f[p[k][[1]],p[k][[2]],a,b,c,d,e]==0,{k,1,5}]

solv1=Flatten[Solve[tab1,{a,b,c,d,e}]]

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+b x y+c y^2+d x+e y + 1/.solv1;

f[x_,y_]:=f[x,y,a,b,c,d,e];
f[x,y]

solv2=Flatten[Solve[f[x,y]==0,{y}]]

graf1[x_]:=y/.solv2[[1]];  pl1= Plot[Evaluate[graf1[x]],{x,-5,5}];

graf2[x_]:=y/.solv2[[2]];  pl2= Plot[Evaluate[graf2[x]],{x,-5,5}];

Show[pl1,pl2];

D[graf2[x],x]

Solve[Evaluate[D[graf2[x],x]]==0,{x}]

Solve[Evaluate[D[graf2[x],x]]==0,{x}]//N

Frage: x max > -0.5 ??  !!

Remove["Global`*"]

Lösung zu Aufgabe 13 
Ellipse c

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

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+ b x y+c y^2+d x+e y+ 1;

tab1=Table[f[p[k][[1]],p[k][[2]],a,b,c,d,e]==0,{k,1,5}]

solv1=Flatten[Solve[tab1,{a,b,c,d,e}]]

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+b x y+c y^2+d x+e y + 1/.solv1;

f[x_,y_]:=f[x,y,a,b,c,d,e];
f[x,y]

solv2=Flatten[Solve[f[x,y]==0,{y}]]

graf1[x_]:=y/.solv2[[1]];  pl1= Plot[Evaluate[graf1[x]],{x,-5,5}];

graf2[x_]:=y/.solv2[[2]];  pl2= Plot[Evaluate[graf2[x]],{x,-5,5}];

Show[pl1,pl2];

D[graf1[x],x]

Solve[Evaluate[D[graf1[x],x]]==0,{x}]

Solve[Evaluate[D[graf1[x],x]]==0,{x}]//N

Frage: x max > -0.5 ??  Ja!!

Remove["Global`*"]

Lösung zu Aufgabe 13 
Ellipse x

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

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+ b x y+c y^2+d x+e y+ 1;

tab1=Table[f[p[k][[1]],p[k][[2]],a,b,c,d,e]==0,{k,1,5}]

solv1=Flatten[Solve[tab1,{a,b,c,d,e}]]

f[x_,y_,a_,b_,c_,d_,e_]:=a x^2+b x y+c y^2+d x+e y + 1/.solv1;

f[x_,y_]:=f[x,y,a,b,c,d,e];
f[x,y]

solv2=Flatten[Solve[f[x,y]==0,{y}]]

graf1[x_]:=y/.solv2[[1]];  pl1= Plot[Evaluate[graf1[x]],{x,-5,5}];

graf2[x_]:=y/.solv2[[2]];  pl2= Plot[Evaluate[graf2[x]],{x,-5,5}];

Show[pl1,pl2];

D[graf1[x],x]

Solve[Evaluate[D[graf1[x],x]]==0,{x}]

Solve[Evaluate[D[graf1[x],x]]==0,{x}]//N

Frage: x max > -0.5 ??

Remove["Global`*"]

Lösung zu Aufgabe 14 a

a

Remove[a,b,c]

a[n_]:=n^4;
b[n_]:=a[n+1]-a[n];
c[n_]:=b[n+1]-b[n];

{b[n],c[n]}//Simplify

Table[c[n],{n,1,10}]

c[9000]

c[9000]//N

b

Solve[(y-4)/8==4/(x-8),{y}]

Solve[(y-4)/8==4/(x-8),{x}]

la[x_]:=Sqrt[x^2+(4 x/(x-8))^2]

Plot[la[x],{x,11,15}];

la'[x]//Simplify

Solve[Evaluate[la'[x]==0],{x}]

Solve[Evaluate[la'[x]==0],{x}]//N

Remove["Global`*"]

Lösung zu Aufgabe 14 c

a

Remove[a,b,c]

a[n_]:=n^4;
b[n_]:=a[n+1]-a[n];
c[n_]:=b[n+1]-b[n];

{b[n],c[n]}//Simplify

Table[c[n],{n,1,10}]

c[10000]

c[10000]//N

b

Solve[(y-3)/6==3/(x-6),{y}]

Solve[(y-3)/6==3/(x-6),{x}]

la[x_]:=Sqrt[x^2+(3x/(x-6))^2]

Plot[la[x],{x,7,12}];

la'[x]//Simplify

Solve[Evaluate[la'[x]==0],{x}]

Solve[Evaluate[la'[x]==0],{x}]//N

Remove["Global`*"]

Lösung zu Aufgabe 14 x

a

Remove[a,b,c]

a[n_]:=n^4;
b[n_]:=a[n]-a[n+1];
c[n_]:= -2(b[n+1]-b[n]);

{b[n],c[n]}//Simplify

Table[c[n],{n,1,10}]

c[20000]

c[20000]//N

Remove["Global`*"]

Lösung zu Aufgabe 15

a

f[x_] := 6 x^3 + 5 x^2 - 6 x^1 + x^0 - 2/x^2

i

D[f[x], x]

ii

D[f[x], x] /. x -> 1

iii

ArcTan[D[f[x], x]] /. x -> 1

N[%]

%/Degree

iv

Plot[
        6 x^3 + 5 x^2 - 6 x^1 + x^0 - 
          2/x^2, {x, -2, -0.5}];

Plot[-6 + (4/(x^3)) + 10 x + 18 (x^2), {x, 0.5, 2}];

Plot[-6 + (4/(x^3)) + 10 x + 18 (x^2), {x, -2, 
          2}];

NSolve[-6 + (4/(x^3)) + 10 x + 18 (x^2) == 
        Tan[Pi/6], {x}]

v

D[f[x], {x, 2}]

b

f[x_] := (E^x + Cos[x])^
          x + ((Sin[x/3 - 3])^2) /(Log[x] - x^2)

D[f[x], x]

D[f[x], x] // Simplify

D[(E^x + Cos[x])^x, x]

D[f[x], x] /. x -> (1. )

Remove["Global`*"]

Lösung zu Aufgabe 16

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

f1[x_] := 
        a1 x^3 + b1 x^2  + c1 x + d1;
f2[x_] := 
        a2 x^3 + b2 x^2  + c2 x + d2;
f3[x_] := a3 x^3 + b3 x^2  + c3 x + d3;

s1 = 
      Flatten[Solve[
          Evaluate[{(D[f1[x], x] == 0 /. x -> 0), 
              f1[0] == 0, f1[1] == 1, f1[2] == 0}], {a1, 
            b1, c1, d1}]]

f1[x_] := (a1 x^3 + b1 x^2  + c1 x + d1 /. s1)

pl1 = Plot[Evaluate[f1[x]], {x, 0, 2}];

s2 = 
      Flatten[Solve[
          Evaluate[{(D[f1[x], x] == D[f2[x], x] /. x -> 2), 
              f2[2] == 0, f2[3] == 1, 
              f2[4] == -1}], {a2, b2, c2, d2}]]

N[%]

f2[x_] := (a2 x^3 + b2 x^2  + c2 x + d2 /. s2)

pl2 = Plot[Evaluate[f2[x]], {x, 2, 4}];

s3 = 
      Flatten[Solve[
          Evaluate[{(D[f2[x], x] == D[f3[x], x] /. x -> 4), 
              f3[4] == -1, f3[6] == 0, 
              f3[7] == 3}], {a3, b3, c3, d3}]]

N[%]

f3[x_] := (a3 x^3 + b3 x^2  + c3 x + d3 /. s3)

pl3 = Plot[Evaluate[f3[x]], {x, 4, 7}];

Show[pl1, pl2, pl3];

D[f1[x], x] /. x -> 2

D[f2[x], x] /. x -> 4

D[f3[x], x] /. x -> 7

N[%]

Remove["Global`*"]

Lösung zu Aufgabe 17

f[x_] := E^x;
Plot[{f[x], -(x - 0.1614393539403694)  2/(E - 1/E) + 
            E^0.1614393539403694, x (E - 1/E)/2 + 0.985477463224239, 
          E^x, x (E - 1/E)/2, x (E - 1/E)/2 + 0.985477463224239, 
          x (E - 1/E)/2, 
          x (E - 1/E)/2 + E -  (E - 1/E)/2}, {x, -1, 1}, 
        AspectRatio -> Automatic];

-(x - 
                  0.1614393539403694)  2/(E - 1/E) + 
          E^0.1614393539403694 // Expand // N

x (E - 1/E)/2 + 0.985477463224239 // Expand // N

fl1 = 
      Solve[1.3125728575551499` - 
              0.8509181282393216` x == 0, {x}] // Flatten

x1 = x /. fl1

fl2 = 
      Solve[0.985477463224239` + 
              1.1752011936438014` x == 0, {x}] // Flatten

x2 = x /. fl2

basis = x1 - x2

(1.5425371889432675 - (-0.8385606384288044`)) 
      E^0.1614393539403694 /2

Plot[{x (E - 1/E)/
                2 + ((-1 + (E^2) + Log[(1/2) (-(1/E) + E)] - (E^2) Log[(1/2) (-(1/E) + E)])/(2 E)), -(x - 0.1614393539403694)  2/(E - 1/E) + 
            E^0.1614393539403694} , {x, -1, 2}, 
        AspectRatio -> Automatic];

Plot[{E^x, x (E - 1/E)/2, 
          x (E - 1/E)/2 + 0.985477463224239, x (E - 1/E)/2, 
          x (E - 1/E)/
                2 + ((-1 + (E^2) + Log[(1/2) (-(1/E) + E)] - (E^2) Log[(1/2) (-(1/E) + E)])/(2 E)), -(x - 0.1614393539403694)  2/(E - 1/E) + E^0.1614393539403694, 
          x (E - 1/E)/2 + E -  (E - 1/E)/2} , {x, -1, 1}, 
        AspectRatio -> Automatic];

fr = FindRoot[E^x ==  (E - 1/E)/2, {x, 1}]

x0 = x /. fr

Log[(E - 1/E)/2] // N

h = E^x0

flaeche = basis h /2

Solve[
      0.1614393539403694 (E - 1/E)/2 + b == 
        E^0.1614393539403694, {b}]

Solve[
      Log[(E - 1/E)/2] (E - 1/E)/2 + b == 
        E^Log[(E - 1/E)/2], {b}]

N[%]

Lösung zu Aufgabe 18

a

Remove["Global`*"]

f[a_, x_, b_] := -a x^2 + b;
bSolv = 
      Flatten[Solve[{f[a, 0, b] == 20, f[a, 20, b] == 0}, {a, 
            b}]]

f[x_] := -1/20  x^2 + 20;

Plot[f[x], {x, -20, 20}];

b

A[x1_] := 2 (x1 f[x1]  + (20 - x1) f[x1]/2) //  Simplify;  
    A[x1]

Plot[A[x1], {x1, 0, 20}, PlotRange -> {0, 500}];

D[A[x1], x1] //  Simplify

Solve[Evaluate[D[A[x1], x1] == 0], {x1}]

N[%]

(Integrate[f[x], {x, -20, 20}] - A[x1]) 20

% // Expand

N[%]

(Integrate[f[x], {x, -20, 20}] - A[x1]) 20 /. {x1 -> 
          (20/3)}

N[%]

Remove["Global`*"]

Lösung zu Aufgabe 19

a

a1 = 1; a2 = -1; a3 = 2; a4 = 12;
a[
          n_] := α n^3 + β n^2 + γ n + δ;
solv = 
      Solve[{a[1] == a1, a[2] == a2, a[3] == a3, 
            a[4] == a4}, {α, β, γ, δ}] // 
        Flatten

a[n_] := α n^3 + β n^2 + γ n + δ /. 
        solv;  a[n]

a[5]

s[n_] := Sum[a[k], {k, 1, n}];  s[n]

s[100]

s[1000]/s[999]

N[%]

b

b[1] = 1; b[n_] := (n + 1) (b[n - 1] - 1)

Table[b[n], {n, 1, 50}]

Table[b[n], {n, 1, 50}] // N

c

Limit[(E^2 - E)/
          Sum[1/k!, {k, 0, n}] (Cos[n^2] + n^2 - 2  n + 
              2)/(3  n^3 + 4  n^2 + 2  n - 1) (n + 1), 
      n -> Infinity]

Limit[Sum[1/k!, {k, 0, n}], n -> Infinity]