NURBS 4. Grades für Metamorphosen  (21.2.24)

Dr . Dörte Haftendorn 2024,  Buch Höhere...., Kapitel Numerik 
www.mathematik-sehen-und-verstehen

Quit

Bernoulli’sche Lemniskate, Kurven /114, Gl.4.29

BernLem=((((x^2)+(y^2)))^2)==(a^2)((x^2)-(y^2))

BernLemni=ContourPlot[((((x^2)+(y^2)))^2)==(4^2)((x^2)-(y^2)),{x,-4,4},{y,-4,4}, AspectRatio->1]

BernPar=ParametricPlot[{{4(1-(t^4))/(1+6 (t^2)+(t^4)),4(2t-2(t^3))/(1+6 (t^2)+(t^4))},{t,-10π,10π},{s,0}},{t,-4π,4π},{s,-4,4}]

Show[{BernLemni,BernPar},{x,-4,4},{y,-4,4}]

Bernsteinpolynome Grad 4

Bern4=(((a+t))^4)//Expand

(a^4)+4 (a^3) t+6 (a^2) (t^2)+4 a (t^3)+(t^4) /.a->(1-t)

B0[t_]:=(((1-t))^4)
B1[t_]:=4t(((1-t))^3)
B2[t_]:=6(t^2)(((1-t))^2)
B3[t_]:=4(t^3)(1-t)
B4[t_]:=(t^4)

Plot[{B0[t],B1[t],B2[t],B3[t], B4[t]},{t,0,1}]

Bestimmung der Gewichte:

Nenner=w0 B0[t]+w1 B1[t]+w2 B2[t]+w3 B3[t]+w4 B4[t]

NennerE=Nenner//Expand

Diese automatisierte Vorgehensweise ist unten nach der Überschrift
Verschobener Anderer Kreis  übernommen.

NennerEC=Collect[NennerE,t]

coef=CoefficientList[NennerEC,t]

Nun braucht man die Koeffizientenliste des Nenners der Parameterdarstellung des Zieles. Das ist hier NennerParam

NennerParam=1+6(t^2)+(t^4)

NParam=CoefficientList[NennerParam,t]

GLS=Table[coef[[i]]==NParam[[i]],{i,1,5}]

low=Solve[GLS,{w0,w1,w2,w3,w4}]

R0z[t_]=w0 B0[t]/.low  (* z bedeutet, dass es nur die Zähler sind*)
R1z[t_]=w1 B1[t]/.low
R2z[t_]=w2 B2[t]/.low
R3z[t_]=w3 B3[t]/.low
R4z[t_]=w4 B4[t]/.low

Dieses sind die Zähler der Basisfunktionen, wenn deren Nenner 1+(t^2) ist.
Die Parameterdarstellung der Kurve, von der man einen NURBS  sucht, muss
man auch auf diesen Nenner bringen.
Dann  bestimmt man, wie unten mehrfach durchgeführt, 
aus Zx und Zy die Koordinaten der Steuerpunkte (Ax,Ay),(Bx,By),...
Das sind die Listen lox und loy. 
Man hat jetzt das Steuergerüst, den Polygonzug   ABCD

Jede Kurve, deren rationale Parametrisierung den Nenner 1+(t^2) hat (spätestens nach passendem Erweitern) ist durch ihr Steuergerüst charakterisiert.
Eine gesetzt in die folgenden Gleichungen einhält man die betreffende Kurve exakt.

NURBS  4. Grades, wenn Nenner  1+(t^2)

NennerParam

1+6 (t^2)+(t^4)

R0[t_]:=((R0z[t])/NennerParam);R1[t_]:=((R1z[t])/NennerParam);R2[t_]:=((R2z[t])/NennerParam);
R3[t_]:=((R3z[t])/NennerParam);R4[t_]:=((R4z[t])/NennerParam)

x[t_]:=Ax R0[t]+Bx R1[t]+Cx R2[t]+Dx R3[t]+Ex R4[t]
y[t_]:=Ay R0[t]+By R1[t]+Cy R2[t]+Dy R3[t] +Ey R4[t]

x[t]

y[t]

Metamorphosen

Vom einem Steuergerüst lässt man Wanderwege ausgehen, auf denen Punkte 
A’, B’,C’,D’ wandern können. Dabei ändert sich die Kurve stetig und kann so in einen anderen NURBS mit beliebigen steuergerüst QRST übergehen. Die Ausgangskurve erhält man nur wieder, wenn man auf einem Steuergerüst landet, das zum Ausgangsgerüst kongruent oder wenigstens (mathematisch) ähnlich ist.
-------------------------
Setzt man lox bzw.  loy in Zx und Zy ein, müssen als Probe die Zähler der ursprünglichen Parameterdarstellung herauskommen.  
--------------------------
Als NURBS-verwandt  könnte man alle Kurven bezeichnen, die eine rationale Parametrisierung mit einem Polynom 3. Grades im Zähler und dem Nenner 1 + (t^2) haben. Letztere ist, mit beliebigen Punkten, dann:

Lemniskate

Zx=Ax R0z[t]+Bx R1z[t]+Cx R2z[t]+Dx R3z[t]+Ex R4z[t]

Sx=Collect[Expand[Zx],t]

mitZPx=Collect[Sx[[1]]-1+(t^4),t](*Mit Param-Zähler x*)

coefMitZPx=CoefficientList[mitZPx,t]

alleGNullx=Table[coefMitZPx[[i]]==0,{i,1,5}]

lox=Solve[alleGNullx,{Ax,Bx,Cx,Dx,Ex}]

Zy=Ay R0z[t]+By R1z[t]+Cy R2z[t]+Dy R3z[t]+Ey R4z[t]

Sy=Collect[Expand[Zy],t]

MitZPy=Collect[Sy[[1]]-2t+2(t^3),t] (* hier y-Ziel eintragen*)

coefMitZPy=CoefficientList[MitZPy,t]

alleGNully=Table[coefMitZPy[[i]]==0,{i,1,5}]

loy=Solve[alleGNully,{Ay,By,Cy,Dy,Ey}]

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]

NURBS  4. Grades,

xz[t_]:=Ax R0z[t]+Bx R1z[t]+Cx R2z[t]+Dx R3z[t]+Ex R4z[t] (* z steht für Zähler*)

xz[t]

yz[t_]:=Ay R0z[t]+By R1z[t]+Cy R2z[t]+Dy R3z[t]+Ey R4z[t]

yz[t]

K[t_]:=(1/NennerParam)((({{Ax}, {Ay}}))(((1-t))^4)+(({{Bx}, {By}}))4(((1-t))^3)t+(({{Cx}, {Cy}}))12(((1-t))^2)(t^2)+(({{Dx}, {Dy}}))16(1-t)(t^3)+(({{Ex}, {Ey}}))8((t)^4))
K[t]

(({{x(t)}, {y(t)}}))->(1/(1+6(t^2)+(t^4)))((({{Ax}, {Ay}}))(((1-t))^4)+(({{Bx}, {By}}))4(((1-t))^3)t+(({{Cx}, {Cy}}))12(((1-t))^2)(t^2)+(({{Dx}, {Dy}}))16(1-t)(t^3)+(({{Ex}, {Ey}}))8((t)^4))