================ BEZIER3（有理ベジエ曲線） ================ Mathematicaを用いた練習を行います。 適当にプログラムの中の数字などを変更して試してみてください。 以下の説明の中で ＊＊＊＊＊ ではさまれた部分を Mathematica に入力して下さい。自分で入力するか、コピー＆ペーストして下さい。 ペーストしたものをShift+Enter(Return) キーで実行します。 上から順に，すべて実行するようにしてください。 上で定義した関数を後で利用すること があります。 有理ベジエ曲線を描くための準備として、まず次を入力してください。 ＊＊＊＊＊＊ << Graphics`Colors` <{0,1}] Bernsteinlist[n_,t_]:=Table[Bernstein[n,j,t],{j,0,n}] Beziercurve[lists_,t_]:=Bernsteinlist[Length[lists]-1,t].lists Beziercurvegraphics[lists_,options___]:= Show[ParametricPlot[Evaluate[Beziercurve[lists,t]],{t,0,1}, AxesLabel->{"x","y"},AspectRatio->Automatic,options], Graphics[Line[lists]] ] ColorBeziercurvegraphics[lists_,color_,options___]:= Show[ ParametricPlot[ Evaluate[Beziercurve[lists,t]],{t,0,1}, AxesLabel-> {"x","y"}, AspectRatio-> Automatic, DisplayFunction-> Identity, PlotStyle-> {color}, options ], Graphics[{color,Line[lists]}], DisplayFunction-> $DisplayFunction ] WeightBezierlistsforcurve[lists_,weightlist_]:=Table[lists[[i]]*weightlist[[i]],{i,1,Length[weightlist]}] RationalBeziercurve[lists_,weightlist_,t_]:= Beziercurve[WeightBezierlistsforcurve[lists,weightlist],t]/Beziercurve[ weightlist,t] RationalBeziercurvegraphics[lists_,weightlist_,options___]:= Show[ ParametricPlot[ Evaluate[RationalBeziercurve[lists,weightlist,t]],{t,0,1}, AxesLabel-> {"x","y"}, AspectRatio-> Automatic,options], Graphics[Line[lists]] ] ColorRationalBeziercurvegraphics[a_,b_,lists_,weightlist_,color_,options___]:= Show[ ParametricPlot[ Evaluate[RationalBeziercurve[lists,weightlist,t]],{t,a,b}, AxesLabel-> {"x","y"}, AspectRatio-> Automatic, DisplayFunction-> Identity, PlotStyle-> {color},options], Graphics[{color,Line[lists]}], DisplayFunction-> $DisplayFunction ] WeightBezierlistsforcurve[lists_,weightlist_]:=Table[lists[[i]]*weightlist[[i]],{i,1,Length[weightlist]}] RationalBeziercurve[lists_,weightlist_,t_]:= Beziercurve[WeightBezierlistsforcurve[lists,weightlist],t]/Beziercurve[ weightlist,t] RationalBeziercurvegraphics[lists_,weightlist_,options___]:= Show[ ParametricPlot[ Evaluate[RationalBeziercurve[lists,weightlist,t]],{t,0,1}, AxesLabel-> {"x","y"},AspectRatio-> Automatic,options ], Graphics[Line[lists]] ] RationalBezieranimate[lists_, weightlist_, color1_,frame_]:= Animate[ Show[ParametricPlot[Evaluate[RationalBeziercurve[lists,weightlist,t]], {t,-0.01,n/frame},AxesLabel-> {"x","y"}, AspectRatio-> Automatic, PlotStyle-> {color1},PlotRange->{{Min[lists],Max[lists]}, {Min[lists],Max[lists]}}], Graphics[Line[lists]]], {n,0,frame,1},Frames->frame] GenerateRationalBezierControlpoints[lists_]:=Table[ Delete[lists[[i]]/Last[lists[[i]]],Length[lists[[i]]]], {i,1,Length[lists]}] GenerateRationalBezierWeights[lists_]:=Table[Last[lists[[i]]],{i,1,Length[lists]}] Beziertransformation[n_]:=Table[Flatten[{Table[0,{j}],Table[combination[i,j]/combination[n,j],{i, j,n}]}],{j,0,n}] Bezierpoints[polynomiallist_,DegreesElevation___]:= Transpose[ Table[ Table[Coefficient[polynomiallist[[j]],t,i],{i,0, DegreesElevation+Max[Exponent[polynomiallist,t]]}]. Beziertransformation[DegreesElevation+Max[Exponent[polynomiallist, t]]], {j,1,Length[polynomiallist]}] ] Projectiveparameterlist[rationalfunctionlist_]:= Cancel[ Flatten[ {Apply[PolynomialLCM,Denominator[ rationalfunctionlist]]*rationalfunctionlist,Apply[ PolynomialLCM,Denominator[rationalfunctionlist]] } ] ] RationalBezierpoints[rationalfunctionlist_,DegreesElevation___]:= GenerateRationalBezierControlpoints[ Transpose[ Table[ Table[ Coefficient[Projectiveparameterlist[rationalfunctionlist][[j]],t, i], {i,0, DegreesElevation+Max[Exponent[ Projectiveparameterlist[rationalfunctionlist],t]]}]. Beziertransformation[DegreesElevation+Max[Exponent[Projectiveparameterlist[rationalfunctionlist],t]]], {j,1,Length[Projectiveparameterlist[rationalfunctionlist]]} ] ] ] Weights[rationalfunctionlist_,DegreesElevation___]:= GenerateRationalBezierWeights[ Transpose[ Table[ Table[ Coefficient[Projectiveparameterlist[ rationalfunctionlist][[j]],t,i], {i,0,DegreesElevation+ Max[Exponent[Projectiveparameterlist[rationalfunctionlist],t]]}]. Beziertransformation[DegreesElevation+Max[Exponent[Projectiveparameterlist[rationalfunctionlist],t]]], {j,1,Length[Projectiveparameterlist[rationalfunctionlist]]} ] ] ] ＊＊＊＊＊＊ ４分の１円を描きましょう。 ＊＊＊＊＊ cpoly:={{1,0},{1,1},{0,1}}; weight:={1,1,2}; A1=ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBeziercurve[cpoly, weight, t_] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ 比較してみましょう。 ＊＊＊＊＊ weight0:={1,1,1}; B1=ColorRationalBeziercurvegraphics[0, 1, cpoly, weight0, Red] ＊＊＊＊＊ ＊＊＊＊＊ weight1:={1,1/2,1}; C1=ColorRationalBeziercurvegraphics[0, 1, cpoly, weight1, Green] ＊＊＊＊＊ ＊＊＊＊＊ Show[A1 ,B1, C1] ＊＊＊＊＊ 双曲線を描きましょう。 ＊＊＊＊＊ cpoly:={{3, -2*2^(1/2)},{1/3, 0},{3, 2*2^(1/2)}}; weight:={1,3,1}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ 重みを変えてみましょう。 ＊＊＊＊＊ cpoly:={{3, -2*2^(1/2)},{1/3, 0},{3, 2*2^(1/2)}}; weight:={1,1/2,1}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ ＊＊＊＊＊ cpoly:={{3, -2*2^(1/2)},{1/3, 0},{3, 2*2^(1/2)}}; weight:={1,1,1}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ デカルトの葉線を描いてみましょう。 ＊＊＊＊＊ cpoly:={{0, 0}, {1, 0}, {2, 1}, {3/2, 3/2}}; weight:={1, 1, 1, 2}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBeziercurve[cpoly, weight, t_] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ アステロイドを描きましょう。 ＊＊＊＊＊ cpoly:={{0, 1}, {0, 1}, {0, 2/3}, {1/4, 1/4}, {2/3, 0}, {1, 0}, {1, 0}}; weight:={1, 1, 6/5, 8/5, 12/5, 4, 8}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ RationalBeziercurve[cpoly, weight, t_] ＊＊＊＊＊ ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ 半円を描きましょう。 ＊＊＊＊＊ cpoly:={{1, 0}, {1, 2}, {-1, 2}, {-1, 0}} weight:={1, 1/3, 1/3, 1}; ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ RationalBeziercurve[cpoly, weight, t_] ＊＊＊＊＊ RationalBezieranimate[ cpoly, weight, Blue, 32] ＊＊＊＊＊ 有理曲線からベジエ点と重みを求めましょう。 ＊＊＊＊＊ curve9[t_] := {(4*(t - 2*t^3 + t^5))/ (1 + 3*t^2 + 3*t^4 + t^6), -((8*(-t^2 + t^4))/ (1 + 3*t^2 + 3*t^4 + t^6))} cpoly=RationalBezierpoints[curve9[t]] weight=Weights[curve9[t]] ＊＊＊＊＊ ＊＊＊＊＊ ColorRationalBeziercurvegraphics[0, 1, cpoly, weight, Blue] ＊＊＊＊＊ ＊＊＊＊＊ ColorRationalBeziercurvegraphics[-10, 10, cpoly, weight, Blue] ＊＊＊＊＊ いろいろなベジエ点を与えて，ベジエ曲線を作って見ましょう． 何かおもしろそうなものができたら、教えて下さい．