Höhere Mathematik sehen und verstehen, 
Haftendorn, Riebesehl, Aug. 2021       Interaktive Version mit kostenlosem Mathematica Player

Beziersplines+B-Splines

Bézierkurven

b0[t_]:=(((1-t))^3);b1[t_]:=3t(((1-t))^2); b2[t_]:=3(t^2)(1-t);b3[t_]:=(t^3)

b0[t]//Expand
b1[t]//Expand
b2[t]//Expand
b3[t]//Expand

Plot[{b0[t],b1[t],b2[t],b3[t],b0[t]+b1[t]+b2[t]+b3[t]},{t,0,1}]

“Didaktische” B-Splines  mit Polynomen 4.Grades

Die echten B-Splines sehen aus wie Polynome 4. Grades, mit zwei doppelten Nullstellen.
Da später Summe 1 verwirklicht werden soll, ist hier ein Faktor a0 vorgesehen.

V[0, t_] := Piecewise[{{a0 t^2 (t - 4)^2, 0 <= t <= 4},{ 0 a0,True}}];

Rekursive Definition

a0=.;V[i_,t_]:=V[i-1,t-1] (*Stückweise Polynome 4, Grades.*)
V[11,t]

su[t_]:=V[0,t ]+V[1,t]+V[2,t ]+V[3,t ]+V[4,t]+V[5,t ]+V[6,t]+V[7,t ]+V[8,t]+V[9,t ]+V[10,t]
+V[11,t ]+V[12,t]+V[13,t ]+V[14,t]+V[15,t ]+V[16,t]+V[17,t ];

a0=(15/512); (* Der Wert ist unten ausführlich bestimmt worden. Hier schon genommen, damit die Zeichnung klappt*)

Plot[{V[0,t ],V[1,t],V[2,t ],V[3,t ],V[4,t],V[5,t ],V[6,t],V[7,t ],V[8,t],V[9,t ]+V[10,t]
+V[11,t ]+V[12,t]+V[13,t ]+V[14,t]+V[15,t ]+V[16,t]+V[17,t ]},{t,0,21},PlotRange->All](*V0 bis V8 einzeln, V9 bis V17 nur Summe*)

Es zeigt sich, dass sie Summe (hier von V9 bis V17) nicht!!!! exakt 1 ist.

a0=(15/512);Plot[{su[t]},{t,3,11}(*,PlotRange->{0,1.2}*)]
a0=.

Die Summe schwankt im Wirkungsbereich gleichmäßig etwa um 1+/- 0.004

Bedingung  zur Bestimmung von a0, Methode 1

Das ist eine Periode der blauen Welle:

swerte=Table[su[t],{t,5,6,(1/10)}]

Integrate[su[t],{t,5,6}] (*der Funktionsmittelwert einer Periode*)

Da alle relevanten Perioden gleich sind, ist das auch der Mittel aller relevanten Perioden.
Also ist a0=(15/512)  ein vernünftiger Wert.

Bedingung  zur Bestimmung von a0 Methode 2

a0=.;
Integrate[V[0,t],{t,0,4}] (* Integral über V0, das sind gerade die 4 Summanden, die im Wirkungsbereich eine Rolle spielen.*)

Solve[%==1,a0](*Da hat Dieter (15/512) her.*)

%//N

Bedingung  zur Bestimmung von a0, Methode ursprünglich

Eine andere Idee ist es, den stets gleichen Maximalwert der Schwankung auf 1 zu setzen.

a0=.;V[i_,t_]:=V[i-1,t-1];sum[t_]:=Sum[V[i,t],{i,0,24}]
Solve[sum[5+(1/2)]==1,a0]

a0=a0/.a0->(4/137)//N

swerte

Allerdings schwankt hier die Summe in etwa [0, 9927, 1] regelmäßig .

Wirkliche B-Splines

B[0,0,t_]:=If[0≤t && t≤1 ,1,0]
B[1,0,t_]:=B[0,0,t-1]

B[1,0,t]

Plot[{B[0,0,t],B[1,0,t]},{t,0,2}]

p1=1;

B[0,1,t_]:=t B[0,0,t]+(2-t)B[1,0,t]

B[0,1,t]

B[1,1,t_]:=B[0,1,t-1]

B[1,1,t]

Plot[{B[0,1,t],B[1,1,t]},{t,0,3}]

p2=2;

B[0,2,t_]:=(t/p2)B[0,1,t]+((p2+1-t)/p2)B[1,1,t]

B[0,2,t]

B[1,2,t_]:=B[0,2,t-1]

B[1,2,t]

B[2,2,t_]:=B[0,2,t-2]

B[2,2,t]

Meins, unten blau, passt

BB[0,2,t_]:=If[0<=t<=1,((t^2)/2),If[1<=t&&t<=2,-(t^2)+3t-(3/2),If[2≤t≤3,((((3-t))^2)/2),0]]]

Plot[{B[0,2,t](*,BB[0,2,t]*),B[1,2,t], B[0,2,t-2],  B[0,2,t-3],B[0,2,t-4], B[0,2,t]+B[1,2,t]+ B[0,2,t-2]+  B[0,2,t-3]+B[0,2,t-4]}, {t,0,7}]

Von diesen Hügeln erhält man beliebig viele durch Verschieben.
Bei n Hügeln verwendbar von 2  bis n, Bereich 0 bis n+2, bei p=2

p3=3

p3=3;

B[0,3,t_]:=(t/p3)B[0,2,t]+((p3+1-t)/p3)B[1,2,t]

B[0,3,t]

B[1,3,t_]:=B[0,3,t-1];

Plot[{B[0,3,t],B[1,3,t]},{t,0,5}]

alle=Plot[{B[0,3,t],B[0,3,t-1],B[0,3,t-2],B[0,3,t-3]
,B[0,3,t-4],B[0,3,t-5],B[0,3,t-6],B[0,3,t-7]
,B[0,3,t-8],B[0,3,t-9]},{t,0,13},PlotRange->{0,0.7}]

Summe=Plot[Sum[B[0,3,t-i],{i,0,9}],{t,0,13},PlotRange->{0,1.1}]

Show[Summe,alle]

Nicht-uniforme B-Splines

Knotenliste

T={0,(1/2),(3/4),(6/5),2,(5/2),3,(17/5),(18/5)}

{0,(1/2),(3/4),(6/5),2,(5/2),3,(17/5),(18/5)}

tt[i_]:=T[[i]]; tt[3]B[i,3,t]

Table[tt[i],{i,1,9}]

Start

BB[i_,0,t_]:=If[tt[i]≤t && t≤tt[i+1] ,1,0];
BB[3,0,t]

Plot[{BB[3,0,t],BB[4,0,t]},{t,(1/2),2}]

Rekursion

p=.

BB[i_,p_,t_]:=((t-tt[i])/(tt[i+p]-tt[i]))BB[i,p-1,t]+((tt[i+p+1]-t)/(tt[i+p+1]-tt[i+1]))BB[i+1,p-1,t]

p=1 entsteht

BB[3,1,t]

BB[4,1,t]

Plot[{(20/9) (-(3/4)+t),(5/4) (2-t)},{t,tt[3],tt[5]}]

Plot[{(20/9) (-(3/4)+t)BB[3,0,t],(5/4) (2-t)BB[4,0,t]},{t,tt[3],tt[5]}]

Plot[{(20/9) (-(3/4)+t) BB[3,0,t]+(5/4) (2-t) BB[4,0,t]},{t,(1/2),4}]

Plot[{BB[3,1,t]//Evaluate},{t,(1/2),2}]

BB[4,1,t]

Plot[{BB[3,1,t],BB[4,1,t]},{t,0,3}]

p=1 fertig

Plot[{BB[3,1,t],BB[4,1,t]},{t,0,3}]

p=2 fertig

Plot[{BB[3,2,t],BB[4,2,t]},{t,0,3}]

p=3 , eine Fkt fertig

nr34=Table[BB[i,3,t],{i,3,4}]

BB[5,3,t]

Plot[BB[5,3,t],{t,0,4}]

Table[BB[i,3,t],{i,1,5}];

p=3 alle fertig

Table[BB[i,3,t],{i,1,5}];

Plot[{BB[1,3,t],BB[2,3,t],BB[3,3,t],BB[4,3,t],BB[5,3,t]},{t,0,4},PlotStyle->Thick]

Dies ist Abb. 5.23 a) in unserem Buch.

Plot[{BB[1,3,t]+BB[2,3,t]+BB[3,3,t]+BB[4,3,t]+BB[5,3,t]},{t,0,4},PlotStyle->Thick]

Rationale  Béziersplines

Ausführliche Dateien für Kreis und Trisektrix (das sind Links)

Bezier Splines

b[0,t_]:=(((1-t))^3);b[1,t_]:=3t(((1-t))^2); b[2,t_]:=3(t^2)(1-t);b[3,t_]:=(t^3)

Table[b[i,t],{i,0,3}]

Gewichte für den Kreis und Trisektrix (Nenner=1+(t^2))

Herleitung der Gewichte in Datei

W={1,1,(4/3),2}

w[i_]:=W[[i+1]]

Table[w[i],{i,0,3}]

nenner=Sum[w[i] b[i,t],{i,0,3}]//Simplify (*Wie erwartet*)

R[i_,t_]:=((w[i] b[i,t])/nenner)

Plot[{R[0,t],R[1,t],R[2,t],R[3,t],b[0,t],b[1,t],b[2,t],b[3,t]},{t,0,1}]

{R[0,t],R[1,t],R[2,t],R[3,t]}

Plot[{R[0,t],R[1,t],R[2,t],R[3,t]},{t,0,1}]

Versuch für die Gerono-Lemniskate

Rw[i_,t_]:=((ww[i] b[i,t])/(Sum[ww[j] b[j,t],{j,0,3}])); 
Rw[i,t]

nennerw=Sum[ww[i] b[i,t],{i,0,3}]

Table[Rw[i,t],{i,0,3}]

Punkte

P={{Ax,Ay}, {Bx,By},{Cx,Cy},{Dx,Dy}}

Gerono- Lemniskate (x^4)=(a^2)((x^2)-(y^2))

Suche nach eine Parametrisierung

a=1;

gerono=ContourPlot[{(x^4)-a((x^2)-(y^2))==0},{x,-1,1},{y,-0.6,0.6}, 
AspectRatio->1, ContourStyle->{Red}];

Manipulate[Show[gerono,Plot[t x,{x,-1,1}, PlotRange->{-0.6,0.6}]],
{{t,-1},-1,1},SaveDefinitions->True]

lox=Solve[(x^4)-a((x^2)-(t^2)(x^2))==0,x]

x[t_]:=(1-(t^2))(1-(t^2)-a)//Simplify

y[t_]:=t (Sqrt[1-(t^2)])

P={{0,0},{b,b},{1,c},{1,0}}

x[t_]=Ax Rw[0,t]+Bx Rw[1,t]+Cx Rw[2,t]+Dx Rw[3,t]

y[t_]=Ay Rw[0,t]+By Rw[1,t]+Cy Rw[2,t]+Dy Rw[3,t]

{Ax=0,Ay=0, Bx=b,By=b,Cx=1,Cy=c,Dx=1,Dy=0}

x[t_]=Ax Rw[0,t]+Bx Rw[1,t]+Cx Rw[2,t]+Dx Rw[3,t]

y[t_]=Ay Rw[0,t]+By Rw[1,t]+Cy Rw[2,t]+Dy Rw[3,t]

Nicht-uniforme didaktische B-Splines

Der Versuch ist missglückt!!

Knotenliste

T={0,(1/2),(3/4),(6/5),2,(5/2),3,(17/5),(18/5)}

tt[i_]:=T[[i]]; tt[3]B[i,3,t]

Table[tt[i],{i,1,9}]

Diverse Versuche sind misslungen