(* Vorgegebene Punkte Q1 ... Q10 *)
qs={{25.,5.},{19.7,5.},{13.,9.1},{9.,9.4},{5.,9.},{2.2,7.5},{1.,5.},{3., 2.1},{8., 2.},{13.,3.5},{18., 4.5},{25.,5.}}
ListPlot[qs,PlotStyle->Directive[{Dashed,PointSize[0.015]}],AspectRatio->Automatic]

(* Punkte Q indiziert *)
Do[q[j]=qs[[j+1]],{j,0,10 }]

(* Aufgabe 1a Linearsystem*)
Clear[ps];system=Join[
Flatten[Table[{ps[1,j]+ps[2,j-1]==2q[j],ps[2,j]-2ps[1,j]+2ps[2,j-1]-ps[1,j-1]=={0.,0.}},{j,1,10}],1],
{ps[1,0]==q[0],ps[2,10]==q[0]}
]

(* Aufgabe 1a Linearsystem* mit symbolischen Variablen *)
(* system=system/.{ps[i_,j_]:>Symbol[ToString[StringForm["p`1``2`",i,j]]]} *)
system=system/.{ps[i_,j_]:>(Subscript[p, i,j])}

(* Variablen symbolische Generierung *)
vars=Flatten@Table[(Subscript[p, i,j]),{j,0,10},{i,1,2}]

(* Längenkontrolle *)
Length/@{system,vars}

(* Matrixdarstellung Gleichungssystem *)
{b,m}=CoefficientArrays[system,vars]

(* Auflösung Linearsystem und Zuweisung zu Kontrollpunkten *)
sols=LinearSolve[m,-b];
Do[
Do[
ps[i,j]=Partition[sols,2][[j+1,i]],
{j,0,10}],
{i,1,2}
]

Length[sols]

Show[
ListPlot[sols,PlotStyle->{Red,PointSize[0.015]},Joined->False],
ListPlot[qs,PlotStyle->{PointSize[0.0075],Dashed},Joined->False],
ListPlot[qs,PlotStyle->{Dashed},Joined->True],
AspectRatio->Automatic
]

(* Berechnung der Bernstein-Bezier-Splines *)
q[11]=q[0];
Do[r[j]=q[j]BernsteinBasis[3,0,t]+ps[1,j] BernsteinBasis[3,1,t]+ps[2,j] BernsteinBasis[3,2,t]+q[j+1]BernsteinBasis[3,3,t],{j,0,10}]

r[1]

Show[
ParametricPlot[Table[r[j],{j,0,10}],{t,0,1}],
PlotRange->All,AspectRatio->Automatic
]

(* Integrierte Grafik aus Einzelkurven *)
Show[
Show[
ListPlot[sols,PlotStyle->{Red,PointSize[0.01]},Joined->False],
ListPlot[qs,PlotStyle->{PointSize[0.01],Dashed},Joined->False],
ListPlot[qs,PlotStyle->{Dashed},Joined->True]
],
Show[
ParametricPlot[Table[r[j],{j,0,10}],{t,0,1},PlotStyle->Directive[Thick,Black]]
],
PlotRange->All,AspectRatio->Automatic
]

r[0]

(* Umwandlung in Potenzformeln *)
Do[r[j]=r[j]/.{BernsteinBasis[d_,k_,x_]:> Binomial[d,k]x^k(1-x)^(d-k)},{j,0,10}]

(* Test Ableitungen *)
r[11]=r[0];
Table[
{D[r[j],{t,1}]/.{t->1},D[r[j+1],{t,1}]/.{t->0}},
{j,0,10}
]

Table[
{D[r[j],{t,2}]/.{t->1},D[r[j+1],{t,2}]/.{t->0}},
{j,0,10}
]