Lösungen - Solutions

Splines, Bezier

1

1 Polynome / Polynômes

Remove["Global`*"]

y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
y[x,a2,a1,a0]

solv = Solve[{
y[1,a2,a1,a0]==2,
y[2,a2,a1,a0]==3,
y[3,a2,a1,a0]==0
},{a2,a1,a0}]//Flatten

y1[x_]:=a2 x^2+a1 x+a0 /. solv ;
y1[x]

?y1

D[y1[x],x]

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

2  Hermite / Hermite

Remove[y,y1]

y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
y[x,a2,a1,a0]

solv = Solve[{
y[2,a2,a1,a0]==3,
y[3,a2,a1,a0]==0,
y[4,a2,a1,a0]==2
},{a2,a1,a0}]//Flatten

y1[x_]:=a2 x^2+a1 x+a0 /. solv ;
y1[x]

?y1

D[y1[x],x]

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

?H

H0[x_]:=2 x^3- 3 x^2     +1;
H1[x_]:=  x^3- 2 x^2+ x    ;
H2[x_]:=  x^3-   x^2       ;
H3[x_]:=  1 - H0[x];

D[H0[x],x]

Plot[{H0[x],Evaluate[D[H0[s],s]/.s->x]},{x,0,1},AspectRatio->Automatic];

Plot[{H1[x]},{x,0,1},AspectRatio->Automatic];

Plot[{H1[x],Evaluate[D[H1[s],s]/.s->x]},{x,0,1},AspectRatio->Automatic];

Plot[{H2[x]},{x,0,1},AspectRatio->Automatic];

Plot[{H2[x],Evaluate[D[H2[s],s]/.s->x]},{x,0,1},AspectRatio->Automatic,PlotRange->All];

Plot[{H3[x]},{x,0,1},AspectRatio->Automatic,PlotRange->All];

Plot[{H3[x],Evaluate[D[H3[s],s]/.s->x]},{x,0,1},AspectRatio->Automatic,PlotRange->All];

{{H0[0],H1[0],H2[0],H3[0]},

{D[H0[x],x]/.x->0,D[H1[x],x]/.x->0,D[H2[x],x]/.x->0,D[H3[x],x]/.x->0},
{D[H0[x],x]/.x->1,D[H1[x],x]/.x->1,D[H2[x],x]/.x->1,D[H3[x],x]/.x->1},{H0[1],H1[1],H2[1],H3[1]}} // MatrixForm

3  Combination / Combinaison ==> Splines

t[x_,i_]:=(x-x0[i])/Δ[i]

p[1]={1,2,3};p[2]={2,3,-1};p[3]={3,0,-1/2};p[4]={4,2,9/2};

x0[i_]:=p[i][[1]];
Δ[i_]:=p[i+1][[1]]-p[i][[1]];

s[i_,x_]:= p[i][[2]] H0[t[x,i]] + p[i][[3]] H1[t[x,i]] + p[i+1][[3]] H2[t[x,i]]  + p[i+1][[2]] H3[t[x,i]];

graph[i_]:=Plot[s[i,x],{x,p[i][[1]],p[i+1][[1]]},PlotRange->All,AspectRatio->Automatic,Epilog->{PointSize[0.03],Point[{p[i][[1]],p[i][[2]]}],Point[{p[i+1][[1]],p[i+1][[2]]}]}];graph[3];

Show[graph[1],graph[2],graph[3],Graphics[
{PointSize[0.03],
Point[{p[1][[1]],p[1][[2]]}],
Point[{p[2][[1]],p[2][[2]]}],
Point[{p[3][[1]],p[3][[2]]}],
Point[{p[4][[1]],p[4][[2]]}]
}
]];

2

4  Work:  Take p[k]={k,f[k]}, k = 0,1,2,....,12,...,  f[x] = Sin[x]
==> Splines?

Remove["Global`*"]

Funktion / Fonction

f[x_]:=Sin[x];
x1=0; x2=20; n=40;

Punkte / Points

Floor[x1]+ k (Floor[x2]-Floor[x1])/n

pTab[f_,x1_,x2_,n_]:= Table[{Floor[x1]+ k (Floor[x2]-Floor[x1])/n ,f[Floor[x1]+ k (Floor[x2]-Floor[x1])/n] },{k,0,n}];
pTab[f ,x1,x2,n]//N

x-Werte der Punkte / Valeurs x des points

xTab[f_,x1_,x2_,n_]:= Table[ Floor[x1]+ k (Floor[x2]-Floor[x1])/n ,{k,0,n}];
xTab[f ,x1,x2,n]//N

y-Werte der Punkte / Valeurs y des points

yTab[f_,x1_,x2_,n_]:= Table[ f[Floor[x1]+ k (Floor[x2]-Floor[x1])/n] ,{k,0,n}];
yTab[f ,x1,x2,n]//N

m-Werte in den mittleren Punkten / Valeurs m dans les points au milieu

mTab[f_,x1_,x2_,n_]:= Table[ 
(f[Floor[x1]+ (k+1)(Floor[x2]-Floor[x1])/n]
-f[Floor[x1]+ (k-1)(Floor[x2]-Floor[x1])/n])/(2(Floor[x2]-Floor[x1])/n) ,{k,1,n-1}];
mTab[f ,x1,x2,n]//N

Length[mTab[f ,x1,x2,n]//N]

f[xTab[f,x1,x2,n][[1]]]==yTab[f ,x1,x2,n][[1]]

Spline 1 / Spline 1

y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv1 = Solve[{
y[xTab[f ,x1,x2,n][[1]],a2,a1,a0]==yTab[f ,x1,x2,n][[1]],
y[xTab[f ,x1,x2,n][[2]],a2,a1,a0]==yTab[f ,x1,x2,n][[2]],
y[xTab[f ,x1,x2,n][[3]],a2,a1,a0]==yTab[f ,x1,x2,n][[3]]
},{a2,a1,a0}]//Flatten;
y1[x_]:=a2 x^2+a1 x+a0 /. solv1 ;
m1=D[y1[x],x]/.x -> x1;
m1 //N

(y[xTab[f,x1,x2,n][[1]],a2,a1,a0]/. solv1)==yTab[f ,x1,x2,n][[1]]

Spline n-1 / Spline n-1

Length[xTab[f ,x1,x2,n]//N]

y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv2 = Solve[{
y[xTab[f ,x1,x2,n][[n+1]],a2,a1,a0]==yTab[f ,x1,x2,n][[n+1]],
y[xTab[f ,x1,x2,n][[n]],a2,a1,a0]==yTab[f ,x1,x2,n][[n]],
y[xTab[f ,x1,x2,n][[n-1]],a2,a1,a0]==yTab[f ,x1,x2,n][[n-1]]
},{a2,a1,a0}]//Flatten;
yLn[x_]:=a2 x^2+a1 x+a0 /. solv2 ;
mLn=D[yLn[x],x]/.x -> x2;
mLn //N

m-Werte in allen Punkten / Valeurs m dans tous les points

Length[mTab[f ,x1,x2,n]]

?Prepend

xTabFix = xTab[f ,x1,x2,n]//N

xTabFix = xTab[f ,x1,x2,n]//N; 
yTabFix = yTab[f ,x1,x2,n]//N; 
pTabFix = pTab[f ,x1,x2,n]//N;
mTabFix = Append[Prepend[mTab[f ,x1,x2,n],m1],mLn]//N

Length[mTabFix]

Length[xTabFix]

Test / Test

Length[yTabFix]==Length[xTabFix]

Length[mTabFix]==Length[xTabFix]

Hermite / Hermite

H0[x_]:= 2 x^3- 3 x^2     +1;
H1[x_]:=  x^3- 2 x^2+ x     ;
H2[x_]:=  x^3-   x^2        ;
H3[x_]:=  1 - H0[x]         ;

Plot[H3[x],{x,0,1}];

Splines / Splines

x0[i_]:=xTabFix[[i]];
Δ[i_]:=xTabFix[[i+1]]-xTabFix[[i]];
Length[Table[x0[i],{i,1,Length[xTabFix]}]]

Length[Table[Δ[i],{i,1,Length[xTabFix]-1}]]

t[x_,i_]:=(x-x0[i])/Δ[i];
Length[Table[t[x,i],{i,1,Length[xTabFix]-1}]]

s[i_,x_]:= yTabFix[[i]] H0[t[x,i]] + Δ[i] mTabFix[[i]] H1[t[x,i]] + Δ[i] mTabFix[[i+1]] H2[t[x,i]] + yTabFix[[i+1]] H3[t[x,i]];
Length[Table[s[i,x],{i,1,Length[xTabFix]-1}]]

Δ[2] mTabFix[[2]] H1[t[x,1]]

Length[Table[mTabFix[[i]] H2[t[x,i]],{i,1,Length[xTabFix]-1}]]

Punkte, Graphen / Points, graphiques

Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]

graph[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic,Epilog->Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]];
graph[1];

graphN[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic];
graphN[3];

pl=Plot[Sin[x],{x,0,1.3}];

s1=Show[Table[graphN[k],{k,1,3}]];

Show[pl,s1];

Show[Table[graph[k],{k,1,5}]];

Show[Table[graph[k],{k,Length[xTabFix]-2,Length[xTabFix]-1}],Graphics[
Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]
]];

Show[Table[graph[k],{k,1,Length[xTabFix]-1}],Graphics[
Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]
]];

Show[Table[graph[k],{k,1,Length[xTabFix]-1}]];

Show[Table[graphN[k],{k,1,Length[xTabFix]-1}]];

2

5  Programm:  Take p[k]={k,f[k]}, k = 0,1,2,....,12,..., f[x] =Cos[x]
==> Splines?

Remove["Global`*"]

Programm / Programme

(*   Fehler mit Steigungen.... - Faute poit de vue pentes....!  
Off[General::spell];
Off[General::spelll];
splinesPlot[fIn_,xIn1_,xIn2_,nIn_]:= Module[{pTab, xTab, yTab, mTab, y, solv1, a2, a1, a0, x, y1, m1, solv2, yLn, mLn, xTabFix, yTabFix, mTabFix, pTabFix,  H0,  H1,  H2,  H3, x0, Δ, t, s, pts,graph,graphN },
pTab[f_,x1_,x2_,n_]:= Table[
{Floor[x1]+ k (Floor[x2]-Floor[x1])/n,
f[Floor[x1]+ k (Floor[x2]-Floor[x1])/(n-1)]},{k,0,n}];
xTab[f_,x1_,x2_,n_]:= Table[ Floor[x1]+ k (Floor[x2]-Floor[x1])/n ,{k,0,n}];
yTab[f_,x1_,x2_,n_]:= Table[ f[Floor[x1]+ k (Floor[x2]-Floor[x1])/(n-1)] ,{k,0,n}];
(* mTab[f_,x1_,x2_,n_]:= Table[ (f[Floor[x1]+ (k-1) (Floor[x2]-Floor[x1])/n]+f[Floor[x1]+ (k+1) (Floor[x2]-Floor[x1])/n])/2 ,{k,1,n-1}]; *)
mTab[f_,x1_,x2_,n_]:= Table[ (-f[Floor[x1]+ (k-1) (Floor[x2]-Floor[x1])/n]+f[Floor[x1]+ (k+1) (Floor[x2]-Floor[x1])/n])/(2(Floor[x2]-Floor[x1])/n) ,{k,1,n-1}];
y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv1 = Solve[{
y[xTab[fIn ,xIn1,xIn2,nIn][[1]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[1]],
y[xTab[fIn ,xIn1,xIn2,nIn][[2]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[2]],
y[xTab[fIn ,xIn1,xIn2,nIn][[3]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[3]]
},{a2,a1,a0}]//Flatten;
y1[x_]:=a2 x^2+a1 x+a0 /. solv1 ;
m1=D[y1[x],x]/.x -> xIn1;
y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv2 = Solve[{
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn]],a2,a1,a0]  ==yTab[fIn ,xIn1,xIn2,nIn][[nIn]],
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn-1]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[nIn-1]],
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn-2]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[nIn-2]]
},{a2,a1,a0}]//Flatten;
yLn[x_]:=a2 x^2+a1 x+a0 /. solv2 ;
mLn=D[yLn[x],x]/.x -> xIn2;
xTabFix = xTab[fIn ,xIn1,xIn2,nIn]//N; 
yTabFix = yTab[fIn ,xIn1,xIn2,nIn]//N; 
pTabFix = pTab[fIn ,xIn1,xIn2,nIn];
mTabFix = Append[Prepend[mTab[fIn ,xIn1,xIn2,nIn],m1],mLn]//N;
H0[x_]:=2 x^3- 3 x^2     +1;
H1[x_]:=  x^3- 2 x^2+ x    ;
H2[x_]:=  x^3-   x^2       ;
H3[x_]:=  1 - H0[x];
x0[i_]:=xTabFix[[i]];
Δ[i_]:=xTabFix[[i+1]]-xTabFix[[i]];
t[x_,i_]:=(x-x0[i])/Δ[i];
s[i_,x_]:= yTabFix[[i]] H0[t[x,i]] + mTabFix[[i]] H1[t[x,i]] + mTabFix[[i+1]] H2[t[x,i]] + yTabFix[[i+1]] H3[t[x,i]];
pts = Prepend[Map[Point, pTabFix]//N, PointSize[0.03]];
graph[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic,Epilog->pts,DisplayFunction->Identity];
graphN[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic,DisplayFunction->Identity];
Show[Table[graph[k],{k,1,Length[xTabFix]-1}],DisplayFunction->$DisplayFunction];
Show[Table[graphN[k],{k,1,Length[xTabFix]-1}],DisplayFunction->$DisplayFunction];
];
*)

Remove["Global`*"]

Off[General::spell];
Off[General::spelll];

splinesPlot[fIn_,xIn1_,xIn2_,nIn_]:= Module[
{pTab, xTab, yTab, mTab, y, solv1, a2, a1, a0, x, y1, m1, solv2, yLn, mLn, xTabFix, yTabFix, mTabFix, pTabFix,  H0,  H1,  H2,  H3, x0, Δ, t, s, pts,graph,graphN },
pTab[f_,x1_,x2_,n_]:= Table[{Floor[x1]+ k (Floor[x2]-Floor[x1])/n ,f[Floor[x1]+ k (Floor[x2]-Floor[x1])/n] },{k,0,n}];
xTab[f_,x1_,x2_,n_]:= Table[ Floor[x1]+ k (Floor[x2]-Floor[x1])/n ,{k,0,n}];
yTab[f_,x1_,x2_,n_]:= Table[ f[Floor[x1]+ k (Floor[x2]-Floor[x1])/n] ,{k,0,n}];
mTab[f_,x1_,x2_,n_]:= Table[ 
(f[Floor[x1]+ (k+1)(Floor[x2]-Floor[x1])/n]
-f[Floor[x1]+ (k-1)(Floor[x2]-Floor[x1])/n])/(2(Floor[x2]-Floor[x1])/n) ,{k,1,n-1}];
y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv1 = Solve[{
y[xTab[fIn ,xIn1,xIn2,nIn][[1]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[1]],
y[xTab[fIn ,xIn1,xIn2,nIn][[2]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[2]],
y[xTab[fIn ,xIn1,xIn2,nIn][[3]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[3]]
},{a2,a1,a0}]//Flatten;
y1[x_]:=a2 x^2+a1 x+a0 /. solv1 ;
m1=D[y1[x],x]/.x -> x1;
y[x_,a2_,a1_,a0_]:=a2 x^2+a1 x+a0;
solv2 = Solve[{
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn+1]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[nIn+1]],
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[nIn]],
y[xTab[fIn ,xIn1,xIn2,nIn][[nIn-1]],a2,a1,a0]==yTab[fIn ,xIn1,xIn2,nIn][[nIn-1]]
},{a2,a1,a0}]//Flatten;
yLn[x_]:=a2 x^2+a1 x+a0 /. solv2 ;
mLn=D[yLn[x],x]/.x -> x2;
xTabFix = xTab[fIn ,xIn1,xIn2,nIn]//N; 
yTabFix = yTab[fIn ,xIn1,xIn2,nIn]//N; 
pTabFix = pTab[fIn ,xIn1,xIn2,nIn]//N;
mTabFix = Append[Prepend[mTab[fIn ,xIn1,xIn2,nIn],m1],mLn]//N;
H0[x_]:= 2 x^3- 3 x^2     +1;
H1[x_]:=  x^3- 2 x^2+ x     ;
H2[x_]:=  x^3-   x^2        ;
H3[x_]:=  1 - H0[x]         ;
x0[i_]:=xTabFix[[i]];
Δ[i_]:=xTabFix[[i+1]]-xTabFix[[i]];
t[x_,i_]:=(x-x0[i])/Δ[i];
s[i_,x_]:= yTabFix[[i]] H0[t[x,i]] + Δ[i] mTabFix[[i]] H1[t[x,i]] + Δ[i] mTabFix[[i+1]] H2[t[x,i]] + yTabFix[[i+1]] H3[t[x,i]];
graph[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic,Epilog->Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]];
graph[1];
graphN[i_]:=Plot[s[i,x],{x,xTabFix[[i]],xTabFix[[i+1]]},PlotRange->All,AspectRatio->Automatic];
graphN[3];
sw1=Show[Table[graph[k],{k,1,Length[xTabFix]-1}],Graphics[
Prepend[Map[Point, pTabFix]//N, PointSize[0.03]]
]];
sw2=Show[Table[graph[k],{k,1,Length[xTabFix]-1}]];
sw3=Show[Table[graphN[k],{k,1,Length[xTabFix]-1}]];
sw0=Show[Plot[fIn[x],{x,xIn1,xIn2}]];
sw4=Show[sw0,sw3];]

Input / Input  --- Output / Output

f[x_]:=Sin[x];
x1=0; x2=20; n=40;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=3;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=4;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=5;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=6;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=7;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=10;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=20;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=40;

splinesPlot[f ,x1, x2 , n]

f[x_]:=Cos[x];
x1=0; x2=10; n=80;

splinesPlot[f ,x1, x2 , n]

3

6  Bezier?
Versuch durchgehende Kurve Q[1] - Q[1,2,3,4] - Q[4], Grad 4 / 
Essayer courbe qui passe par Q[1] - Q[1,2,3,4] - Q[4], degré 4

Remove["Global`*"]

Points Q[1], Q[2], Q[3], Q[4],  g[1]=Q[1] Q[2], g[2]=Q[2] Q[3], g[3]=Q[3] Q[4],

?Q

Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
Q[1,2,3,4]

Table[Q[n],{n,1,4}]

{x1,y1}=Q[1];{xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; y1

Tangenten / Tangentes

v1=Q[2]-Q[1]; vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3]

Kurve / Courbe

c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
c[t,6]

c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;
c1[x,6]

t1=0 ; tm=0.5;  t2=1

max=5;
gl[1]=(c[t1,max]=={x1,y1}); gl[2]=(c[tm,max]=={xm,ym}); gl[3]=(c[t2,max]=={x2,y2});
 
gl[4]=(c1[t1,max]==v1); gl[5]=(c1[tm,max]==vm); gl[6]=(c1[t2,max]==v2); 
solv = Solve[Table[gl[k],{k,1,6}],
Flatten[Table[{a[k],b[k]},{k,0,5}]]]// Flatten

curve[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv;
curve[t]

Plot / Plot

pP=ParametricPlot[curve[t],{t,0,1},AspectRatio->Automatic];

lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
PointSize[0.04], Point[Q[1]],Point[Q[2]],Point[Q[3]],Point[Q[4]]}
],AspectRatio->Automatic];

lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}],
PointSize[0.04], Point[Q[1]],Point[Q[2]],Point[Q[3]],Point[Q[4]],
PointSize[0.025],Point[Q[1,2]],Point[Q[2,3]],Point[Q[3,4]],Point[Q[1,2,3]],Point[Q[2,3,4]],
PointSize[0.033],Point[Q[1,2,3,4]]}
],AspectRatio->Automatic];

Show[lin,pP,Graphics[{PointSize[0.03],Point[Q[1,2,3,4]],Point[Q[1]],Point[Q[4]]}]];

Ergebnis schlecht! Alle Geraden sollten Kurventangenten sein! / Résultat mauvaise! Toutes les droites doivent être des tanentes à la courbe!

7  Bezier?
Versuch geteilte Kurven Q[1] - Q[1,2,3,4],  Q[1,2,3,4] - Q[4], Grad 3 / 
Essayer courbe qui passe par Q[1] - Q[1,2,3,4],  Q[1,2,3,4] - Q[4], degré 3

Remove["Global`*"]

max=3;
Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;
t1=0; t2=1;
gl[1]=(c[t1,max]=={x1,y1}); gl[2]=(c[t2,max]=={xm,ym}); gl[3]=(c1[t1,max]==v1); gl[4]=(c1[t2,max]==vm);
gl[5]=(c[t1,max]=={xm,ym}); gl[6]=(c[t2,max]=={x2,y2}); gl[7]=(c1[t1,max]==vm); gl[8]=(c1[t2,max]==v2);

solv1 = Solve[{gl[1],gl[2],gl[3],gl[4]},
Flatten[Table[{a[k],b[k]},{k,0,3}]]]// Flatten; Print[solv1];
solv2 = Solve[{gl[5],gl[6],gl[7],gl[8]},
Flatten[Table[{a[k],b[k]},{k,0,3}]]]// Flatten; Print[solv2];

curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; Print[curve1[t]];
curve2[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv2; Print[curve2[t]];

pP=ParametricPlot[{curve1[t],curve2[t]},{t,0,1},AspectRatio->Automatic];

lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic];

Show[lin,pP,Graphics[{PointSize[0.03],Point[Q[1,2,3,4]],Point[Q[1]],Point[Q[4]]}]];

Ergebnis besser! Noch nicht befriedigend / Résultat meilleur! Mais pas encore satisfaisant!

8  Bezier?
Versuch geteilte Kurven Q[1] - Q[1,2],  Q[3,4] - Q[4], Grad 2 / 
Essayer courbe qui passe par Q[1] - Q[1,2],  Q[3,4] - Q[4], degré 2

Remove["Global`*"]

max=2;
Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm1,ym1}=Q[1,2,3]; {xm2,ym2}=Q[2,3,4]; {xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm1=Q[2,3]-Q[1,2]; vm2=Q[3,4]-Q[2,3];vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
Print[c[t,max]];
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;  Print[c1[t,max]];
gl[1]=(c[t1,max][[1]]==x1);
gl[2]=(c[t1,max][[2]]==y1);
gl[3]=(c[t2,max][[1]]==xm1);
gl[4]=(c[t2,max][[2]]==ym1);
gl[5]=(c1[t1,max][[1]]==v1[[1]]);
gl[6]=(c1[t1,max][[2]]==v1[[2]]);
gl[7]=(c1[t2,max][[1]]==vm1[[1]]);
gl[8]=(c1[t2,max][[2]]==vm1[[2]]);
Print["c1   ",{gl[1],gl[2],gl[3],gl[4],gl[5],gl[6],gl[7],gl[8]}];
solv1 = Solve[Prepend[Table[gl[k],{k,1,8}],t1==0],
{t2,a[0],a[1],a[2],b[0],b[1],b[2]}]// Flatten; Print["c1   ",solv1];
gl[11]=(c[t1,max][[1]]==x2);
gl[12]=(c[t1,max][[2]]==y2);
gl[13]=(c[t2,max][[1]]==xm2);
gl[14]=(c[t2,max][[2]]==ym2);
gl[15]=(c1[t1,max][[1]]==v2[[1]]);
gl[16]=(c1[t1,max][[2]]==v2[[2]]);
gl[17]=(c1[t2,max][[1]]==vm2[[1]]);
gl[18]=(c1[t2,max][[2]]==vm2[[2]]);
Print["c2   ",{gl[11],gl[12],gl[13],gl[14],gl[15],gl[16],gl[17],gl[18]}];
solv2 = Solve[Prepend[Table[gl[k],{k,11,18}],t1==0],
{t2,a[0],a[1],a[2],b[0],b[1],b[2]}]// Flatten; Print["c2   ",solv2];
curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; Print["c1   ",curve1[t]];
curve2[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv2; Print["c2   ",curve2[t]];
pP1=ParametricPlot[curve1[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];
pP2=ParametricPlot[curve2[t],{t,-1,0},AspectRatio->Automatic,DisplayFunction->Identity];


lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic];

Show[lin,pP1,pP2,Graphics[{PointSize[0.03],Point[Q[1,2,3]],Point[Q[2,3,4]],Point[Q[1]],Point[Q[4]]}],DisplayFunction->$DisplayFunction];

Ergebnis nicht befriedigend! Mittelstück fehlt... / Le résultat ne satisfait pas! La pièce au milieu manque!

9  Bezier?
Versuch geteilte Kurven Q[1] - Q[1,2,3,4],  Q[1,2,3,4] - Q[4], Tangentialvektoren variabel lang / 
Essayer courbe partagée qui passe par Q[1] - Q[1,2,3,4],  Q[1,2,3,4] - Q[4], longueur des vecteurs tangentiels indéfinie

Remove["Global`*"]

max=2; t1=0; t2=1;
Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm1,ym1}=Q[1,2,3]; {xm2,ym2}=Q[2,3,4]; {xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm1=Q[2,3]-Q[1,2]; vm2=Q[3,4]-Q[2,3];vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
Print[c[t,max]];
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;  Print[c1[t,max]];
gl[1]=(c[t1,max][[1]]==x1);
gl[2]=(c[t1,max][[2]]==y1);
gl[3]=(c[t2,max][[1]]==xm);
gl[4]=(c[t2,max][[2]]==ym);
gl[5]=(c1[t1,max][[1]]==α v1[[1]]);
gl[6]=(c1[t1,max][[2]]==α v1[[2]]);
gl[7]=(c1[t2,max][[1]]==β vm[[1]]);
gl[8]=(c1[t2,max][[2]]==β vm[[2]]);

Print["c1   ",{gl[1],gl[2],gl[3],gl[4],gl[5],gl[6],gl[7],gl[8]}];
solv1 = Solve[Table[gl[k],{k,1,8}],
{α,β,a[0],a[1],a[2],b[0],b[1],b[2]}]// Flatten; Print["c1   ",solv1];

gl[11]=(c[t1,max][[1]]==x2);
gl[12]=(c[t1,max][[2]]==y2);
gl[13]=(c[t2,max][[1]]==xm);
gl[14]=(c[t2,max][[2]]==ym);
gl[15]=(c1[t1,max][[1]]==α v2[[1]]);
gl[16]=(c1[t1,max][[2]]==α v2[[2]]);
gl[17]=(c1[t2,max][[1]]==β vm[[1]]);
gl[18]=(c1[t2,max][[2]]==β vm[[2]]);
Print["c2   ",{gl[11],gl[12],gl[13],gl[14],gl[15],gl[16],gl[17],gl[18]}];

solv2 = Solve[Table[gl[k],{k,11,18}],
{α,β,a[0],a[1],a[2],b[0],b[1],b[2]}]// Flatten; Print["c2   ",solv2];

curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; Print["c1   ",curve1[t]];
curve2[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv2; Print["c2   ",curve2[t]];
pP1=ParametricPlot[curve1[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];
pP2=ParametricPlot[curve2[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];


lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic,DisplayFunction->Identity];

Show[lin,pP1,pP2,Graphics[{PointSize[0.03],Point[Q[1,2,3,4]],Point[Q[1]],Point[Q[4]]}],DisplayFunction->$DisplayFunction];

Ergebnis besser! Nicht alle Teilstücke sind Tangenten! / Résultat meilleur! Pas tous les parites des droites sont des tangentes!

10  Bezier?
Versuch ungeteilte Kurven Q[1] - Q[4], Tangentialvektoren variabel lang, Grad 2 / 
Essayer courbe non partagée qui passe par Q[1] - Q[4], longueur des vecteurs tangentiels indéfinie, degré 2

Remove["Global`*"]

max=2; t1=0; t2=1;
Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm1,ym1}=Q[1,2,3]; {xm2,ym2}=Q[2,3,4]; {xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm1=Q[2,3]-Q[1,2]; vm2=Q[3,4]-Q[2,3];vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
Print[c[t,max]];
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;  Print[c1[t,max]];
gl[1]=(c[t1,max][[1]]==x1);
gl[2]=(c[t1,max][[2]]==y1);
gl[3]=(c[t2,max][[1]]==x2);
gl[4]=(c[t2,max][[2]]==y2);
gl[5]=(c1[t1,max][[1]]==α v1[[1]]);
gl[6]=(c1[t1,max][[2]]==α v1[[2]]);
gl[7]=(c1[t2,max][[1]]==β v2[[1]]);
gl[8]=(c1[t2,max][[2]]==β v2[[2]]);

Print["c1   ",{gl[1],gl[2],gl[3],gl[4],gl[5],gl[6],gl[7],gl[8]}];
solv1 = Solve[Table[gl[k],{k,1,8}],
{α,β,a[0],a[1],a[2],b[0],b[1],b[2]}]// Flatten; Print["c1   ",solv1];

curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; Print["c1   ",curve1[t]];

pP1=ParametricPlot[curve1[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];

lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic,DisplayFunction->Identity];

Show[lin,pP1,DisplayFunction->$DisplayFunction];

Ergebnis besser! Nicht alle Teilstücke sind Tangenten! / Résultat meilleur! Pas tous les parites des droites sont des tangentes!

11  Bezier?
Versuch ungeteilte Kurven Q[1] - Q[4], Tangentialvektoren variabel lang, Grad 3 / 
Essayer courbe non partagée qui passe par Q[1] - Q[4], longueur des vecteurs tangentiels indéfinie, degré 3

Remove["Global`*"]

max=3; t1=0; t2=1;
Q[1]={1,2};Q[2]={3,8};Q[3]={7,9};Q[4]={10,0};
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm1,ym1}=Q[1,2,3]; {xm2,ym2}=Q[2,3,4]; {xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm1=Q[2,3]-Q[1,2]; vm2=Q[3,4]-Q[2,3];vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
Print[c[t,max]];
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt;  Print[c1[t,max]];
gl[1]=(c[t1,max][[1]]==x1);
gl[2]=(c[t1,max][[2]]==y1);
gl[3]=(c[t2,max][[1]]==x2);
gl[4]=(c[t2,max][[2]]==y2);
gl[5]=(c1[t1,max][[1]]==α v1[[1]]);
gl[6]=(c1[t1,max][[2]]==α v1[[2]]);
gl[7]=(c1[t2,max][[1]]==β v2[[1]]);
gl[8]=(c1[t2,max][[2]]==β v2[[2]]);
gl[9]=(c[tm,max][[1]]==xm);
gl[10]=(c[tm,max][[2]]==ym);
gl[11]=(c1[tm,max][[1]]==γ vm[[1]]);
gl[12]=(c1[tm,max][[2]]==γ vm[[2]]);

Print["c1   ",{gl[1],gl[2],gl[3],gl[4],gl[5],gl[6],gl[7],gl[8],gl[9],gl[10],gl[11],gl[12]}];
solv1 = Solve[Table[gl[k],{k,1,12}],
{tm, α,β,γ,a[0],a[1],a[2],a[3],b[0],b[1],b[2],b[3]}]// Flatten; Print["c1   ",solv1];

curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; Print["c1   ",curve1[t]];

pP1=ParametricPlot[curve1[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];

lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic,DisplayFunction->Identity];

Show[lin,pP1,Graphics[{PointSize[0.03],Point[Q[1,2,3,4]],Point[Q[1]],Point[Q[4]]}],DisplayFunction->$DisplayFunction];

Ergebnis befriedigend! (Nicht alle Teilstücke sind Tangenten!) / Résultat meilleur! (Pas tous les parites des droites sont des tangentes!)

4

12  Bezier: Animate !!! ----
Verschiebung von Kurvenpunkten / Déplacer les Points de la courbe

Remove["Global`*"]

max=3; t1=0; t2=1;
Q1={1,2};Q2={3,8};Q3={7,9};Q4={10,0};

bezier[Q1_,Q2_,Q3_,Q4_,max_,t1_,t2_]:= Module[{Q,x1,y1,xm1,ym1,xm2,ym2,xm,ym,x2,y2,v1,vm1,vm2,vm,v2,c,c1t,tt,gl,solv1,α,β,γ,a,b,pP1,lin},
Q[1]=Q1;Q[2]=Q2;Q[3]=Q3;Q[4]=Q4;
Q[m_,n_]:=(Q[m]+Q[n])/2;
Q[m_,n_,r_]:=(Q[m,n]+Q[n,r])/2;
Q[m_,n_,r_,s_]:=(Q[m,n,r]+Q[n,r,s])/2;
{x1,y1}=Q[1];{xm1,ym1}=Q[1,2,3]; {xm2,ym2}=Q[2,3,4]; {xm,ym}=Q[1,2,3,4];{x2,y2}=Q[4]; 
v1=Q[2]-Q[1]; vm1=Q[2,3]-Q[1,2]; vm2=Q[3,4]-Q[2,3];vm=Q[2,3,4]-Q[1,2,3]; v2=Q[4]-Q[3];
c[t_,n_] := {a[0]+Sum[a[k] t^k,{k,1,n}], b[0]+Sum[b[k] t^k,{k,1,n}]};
c1[tt_,n_]:=Evaluate[D[c[t,n],t]]/.t->tt; 
gl[1]=(c[t1,max][[1]]==x1);
gl[2]=(c[t1,max][[2]]==y1);
gl[3]=(c[t2,max][[1]]==x2);
gl[4]=(c[t2,max][[2]]==y2);
gl[5]=(c1[t1,max][[1]]==α v1[[1]]);
gl[6]=(c1[t1,max][[2]]==α v1[[2]]);
gl[7]=(c1[t2,max][[1]]==β v2[[1]]);
gl[8]=(c1[t2,max][[2]]==β v2[[2]]);
gl[9]=(c[tm,max][[1]]==xm);
gl[10]=(c[tm,max][[2]]==ym);
gl[11]=(c1[tm,max][[1]]==γ vm[[1]]);
gl[12]=(c1[tm,max][[2]]==γ vm[[2]]);
solv1 = Solve[Table[gl[k],{k,1,12}],
{tm, α,β,γ,a[0],a[1],a[2],a[3],b[0],b[1],b[2],b[3]}]// Flatten; 
curve1[t_] := {a[0]+Sum[a[k] t^k,{k,1,max}], b[0]+Sum[b[k] t^k,{k,1,max}]}/. solv1; 
pP1=ParametricPlot[curve1[t],{t,0,1},AspectRatio->Automatic,DisplayFunction->Identity];
lin=Show[Graphics[
{Line[{Q[1],Q[2]}],
Line[{Q[2],Q[3]}],
Line[{Q[3],Q[4]}],
Line[{Q[1,2],Q[2,3]}],
Line[{Q[2,3],Q[3,4]}],
Line[{Q[1,2,3],Q[2,3,4]}]}
],AspectRatio->Automatic,DisplayFunction->Identity];

Show[lin,pP1,Graphics[{PointSize[0.03],Point[Q[1,2,3,4]],Point[Q[1]],Point[Q[4]]}],DisplayFunction->$DisplayFunction];];
Table[bezier[Q1,{3+n/5,8+n^2/10},Q3,Q4,max,t1,t2],{n,-10,10}];

bezier[Q1,Q2,Q3,Q4,max,t1,t2]

Ergebnis befriedigend! (Nicht alle Teilstücke sind Tangenten!) / Résultat meilleur! (Pas tous les parites des droites sont des tangentes!)

Work

Teile die Strecken statt im Verhältnis 1:1 nun im Verhältnis λ:(1-λ) ! /
Partager les lignes droites dans le rapport  λ:(1-λ) au leu de 1:1 !