NURBS 3. Grades für Metamorphosen

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

Quit

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

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

Bestimmung der Gewichte:

Nenner=w0 b0[t]+w1 b1[t]+w2 b2[t]+w3 b3[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+t^2

NParam=CoefficientList[1+t^2,t]

NParam2=Append[NParam,0] (* von Hand machen!!!!*)

GLS=Table[coef[[i]]==NParam2[[i]],{i,1,4}]

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

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

Plot[{((R0z[t])/(1+(t^2))),((R1z[t])/(1+(t^2))),((R2z[t])/(1+(t^2))),((R3z[t])/(1+(t^2)))},{t,-5,5}]

Plot[{((((1-t))^3)/(1+(t^2))),((3 (((1-t))^2) t)/(+(t^2))),((4 (1-t) (t^2))/(1+(t^2))),((2 (t^3))/(1+(t^2)))(*),(1/(1+(t^2)))*)},{t,0,1}]

blau orange, grün, rot, die vier Basisfunktionen

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.
Eingesetzt in die folgenden Gleichungen einhält man die betreffende Kurve exakt.

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

R0[t_]:=((R0z[t])/(1+(t^2)));R1[t_]:=((R1z[t])/(1+(t^2)));R2[t_]:=((R2z[t])/(1+(t^2)));R3[t_]:=((R3z[t])/(1+(t^2)1))

x[t_]:=Ax R0[t]+Bx R1[t]+Cx R2[t]+Dx R3[t]
y[t_]:=Ay R0[t]+By R1[t]+Cy R2[t]+Dy R3[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:

xt=(1/(1+(t^2)))(Ax (((1-t))^3)+3 Bx (((1-t))^2) t+4 Cx (1-t) (t^2)+2 Dx (t^3))
yt=(1/(1+(t^2)))(Ay (((1-t))^3)+3 By (((1-t))^2) t+4 Cy (1-t) (t^2)+2 Dy (t^3))

Kreis

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

Sx=Collect[Expand[Zx],t]

Collect[Sx[[1]]-2 t,t](* hier x-Ziel negativ  eintragen*)

lox=Solve[{Ax==0,-2-3 Ax+3 Bx==0,3 Ax-6 Bx+4 Cx==0,
- Ax+3 Bx-4 Cx+2 Dx==0},{Ax,Bx,Cx,Dx}]

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

Sy=Collect[Expand[Zy],t]

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

loy=Solve[{-1+Ay==0,-3 Ay+3 By==0,1+3 Ay-6 By+4 Cy==0,
- Ay+3 By-4 Cy+2 Dy==0},{Ay,By,Cy,Dy}]

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]

Trisektrix

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

Sx=Collect[Expand[Zx],t]

Collect[Sx[[1]]-3a +a t^2,t]

lox=Solve[{-3a +Ax==0,-3 Ax+3 Bx==0,a+3 Ax-6 Bx+4 Cx==0,
- Ax+3 Bx-4 Cx+2 Dx==0},{Ax,Bx,Cx,Dx}]

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

Sy=Collect[Expand[Zy],t]

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

loy=Solve[{Ay==0,-3a-3 Ay+3 By==0,3 Ay-6 By+4 Cy==0,
a- Ay+3 By-4 Cy+2 Dy==0},{Ay,By,Cy,Dy}]

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]

Versiera

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

Sx=Collect[Expand[Zx],t]

Collect[Sx[[1]]-2a t-2a t^3,t]

Ax+(-2 a-3 Ax+3 Bx) t+(3 Ax-6 Bx+4 Cx) (t^2)+(-2 a-Ax+3 Bx-4 Cx+2 Dx) (t^3)

Ax+(-2 a-3 Ax+3 Bx) t+(3 Ax-6 Bx+4 Cx) (t^2)+(-2 a-Ax+3 Bx-4 Cx+2 Dx) (t^3)

lox=Solve[{Ax==0,-2a-3 Ax+3 Bx==0,3 Ax-6 Bx+4 Cx==0,
-2a- Ax+3 Bx-4 Cx+2 Dx==0},{Ax,Bx,Cx,Dx}]

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

{Ay (((1-t))^3)+3 By (((1-t))^2) t+4 Cy (1-t) (t^2)+2 Dy (t^3)}

Sy=Collect[Expand[Zy],t]

Collect[Sy[[1]]-2a,t] (* hier y-Ziel eintragen*)

loy=Solve[{-2a+Ay==0,-3 Ay+3 By==0,3 Ay-6 By+4 Cy==0,
- Ay+3 By-4 Cy+2 Dy==0},{Ay,By,Cy,Dy}]

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]

Kreis der Versiera

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

Sx=Collect[Expand[Zx],t]

Collect[Sx[[1]]-2a t(1+t^2),t]

lox=Solve[{Ax==0,-4-3 Ax+3 Bx==0,3 Ax-6 Bx+4 Cx==0,
- Ax+3 Bx-4 Cx+2 Dx==0},{Ax,Bx,Cx,Dx}]

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

Sy=Collect[Expand[Zy],t]

Collect[Sy[[1]]-4 ,t] (* hier y-Ziel eintragen*)

loy=Solve[{-4+Ay==0,-3 Ay+3 By==0,3 Ay-6 By+4 Cy==0,
- Ay+3 By-4 Cy+2 Dy==0},{Ay,By,Cy,Dy}]

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]

Verschobener anderer Kreis       zum Start

Kreis um (2,0) Radius 2 , Konstr. Trisektrix

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

Sx=Collect[Expand[Zx],t]

MitParx=Collect[Sx[[1]]-2 t^2-4t-2,t](* hier x-Ziel negativ  eintragen*)

Stx=CoefficientList[MitParx,t]

StGlsx=Table[Stx[[i]]==0,{i,1,4}]

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

Hier wird bestätigt, dass man das Gerüst als Form angepasst an den entsprechenden Punkt übertragen kann.

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

Sy=Collect[Expand[Zy],t]

MitPary=Collect[Sy[[1]]+2 t^2-2,t](* hier x-Ziel negativ  eintragen*)

Sty=CoefficientList[MitPary,t]

StGlsy=Table[Sty[[i]]==0,{i,1,4}]

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

Hier wird bestätigt, dass man das Gerüst als Form angepasst an den entsprechenden Punkt übertragen kann.

Proben

Zx/.lox[[1]]

Colect[Expand[%],t]

Zy/.loy[[1]]

Colect[Expand[%],t]