================ BEZIER2　(次数上げ，細分割） ================ Mathematicaを用いた練習を行います。 適当にプログラムの中の数字などを変更して試してみてください。 以下の説明の中で ＊＊＊＊＊ ではさまれた部分を Mathematica に入力して下さい。自分で入力するか、コピー＆ペーストして下さい。 ペーストしたものをShift+Enter(Return) キーで実行します。 上から順に，すべて実行するようにしてください。 上で定義した関数を後で利用すること があります。 平面上にベジエ曲線を描くための準備として、まず次を入力してください． ＊＊＊＊＊ < {0,1}] Bernsteinlist[n_, t_]:=Table[Bernstein[n,j,t],{j,0,n}] Beziercurve[lists_, t_]:=Bernsteinlist[Length[lists]-1,t].lists Beziercurvegraphicsnew[lists_,options___]:= Show[ParametricPlot[Evaluate[Beziercurve[lists,t]],{t,0,1}, AxesLabel -> { "x","y"}, AspectRatio -> Automatic, DisplayFunction -> Identity,options], Graphics[Line[lists]], DisplayFunction -> $DisplayFunction] ColorBeziercurvegraphics[lists_, color_, options___] := Show[ ParametricPlot[ Evaluate[Beziercurve[lists, t]], {t, 0, 1}, AxesLabel -> {"x", "y"}, AspectRatio -> Automatic, PlotStyle -> {color}, options ], Graphics[{color, Line[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]} ] ] ＊＊＊＊＊ ベジエ点を与えるとき，ベジエ曲線を求めましょう． 放物線の例です． ＊＊＊＊＊ cpoly = {{-1, 1}, {0, -1}, {1, 1}} Beziercurve[cpoly, t] ＊＊＊＊＊ ＊＊＊＊＊ Factor[%] ＊＊＊＊＊ 逆に，放物線をパラメータで与えるとき，ベジエ点を求めましょう． ＊＊＊＊＊ curve1[t_] := {t, t^2} A0 = Bezierpoints[curve1[2t - 1]] ＊＊＊＊＊ ＊＊＊＊＊ B0 = Beziercurvegraphicsnew[A0, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ベジエ曲線の次数上げを考えましょう．放物線の次数上げをしましょう． ＊＊＊＊＊ A1 = Bezierpoints[curve1[2t - 1], 1] B1 = Beziercurvegraphicsnew[A1, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ さらに，次数を上げます． ＊＊＊＊＊ A2 = Bezierpoints[curve1[2t - 1], 2] B2 = Beziercurvegraphicsnew[A2, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A4 = Bezierpoints[curve1[2t - 1], 4] B4= Beziercurvegraphicsnew[A4, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A8 = Bezierpoints[curve1[2t - 1], 8] B8 = Beziercurvegraphicsnew[A8, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A16 = Bezierpoints[curve1[2t - 1], 16] B16 = Beziercurvegraphicsnew[A16, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A32 = Bezierpoints[curve1[2t - 1], 32] B32 = Beziercurvegraphicsnew[A32, PlotStyle -> {Thickness[0.008], Blue} , PlotRange -> All] ＊＊＊＊＊ ベジエ多角形が放物線に近づくことを見ましょう． ＊＊＊＊＊ Show[B0, B1, B4, B8, B16, B32] ＊＊＊＊＊ 3次曲線の場合の次数上げ ＊＊＊＊＊ cpoly := {{3, 2}, {-1, -3}, {-1, 3}, {3, -2}}; Beziercurve[cpoly, t] ＊＊＊＊＊ ＊＊＊＊＊ A0 = Bezierpoints[Beziercurve[cpoly, t] ] B0 = Beziercurvegraphicsnew[ A0, PlotPoints -> 50, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A1 = Bezierpoints[Beziercurve[cpoly, t], 1] B1 = Beziercurvegraphicsnew[ A1, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A2 = Bezierpoints[Beziercurve[cpoly, t], 2] B2 = Beziercurvegraphicsnew[ A2, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A4 = Bezierpoints[Beziercurve[cpoly, t], 4] B4 = Beziercurvegraphicsnew[ A4, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A8 = Bezierpoints[Beziercurve[cpoly, t], 8] B8 = Beziercurvegraphicsnew[ A8, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A16 = Bezierpoints[Beziercurve[cpoly, t], 16] B16 = Beziercurvegraphicsnew[ A16, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ ＊＊＊＊＊ A32 = Bezierpoints[Beziercurve[cpoly, t], 32] B32 = Beziercurvegraphicsnew[ A32, PlotStyle -> {Thickness[0.008], Blue}, PlotRange -> All] ＊＊＊＊＊ やはり，ベジエ多角形が曲線に近づくことを見ましょう． ＊＊＊＊＊ Show[B0, B1, B4, B8, B16, B32] ＊＊＊＊＊ つぎ場合と比較してみましょう．同じように次数上げをしましょう． ＊＊＊＊＊ cpoly:={{3,2}, { -1, -2}, {-1,2}, {3,-2}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly:={{3,2}, { -1, -1}, {-1,1}, {3,-2}} ＊＊＊＊＊ 高次のベジエ曲線の場合の次数上げを考えましょう． 次数を上げて行くとどうなりますか． ＊＊＊＊＊ cpoly := {{-1, 0}, {-1, 2}, {2, 3}, {4, 1}, {3, -1}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly = {{-3, 3}, {-1, 3}, {-1, 1}, {-3, 1}, {-3, 0}, {0, 0}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly := {{-1, 0}, {1, 2}, {-1, 2}, {0, 3}, {1, 2}, {1, 0}, {-1, 2}, {-1, 0}} ＊＊＊＊＊ 次に，ベジエ曲線の細分割を考えましょう． 数回細分割するとベジエ曲線にほとんど一致することを確かめましょう． BEZIER1と同様のプログラムを用います．少し長いですが，コピーして貼付けてください． ＊＊＊＊＊ <{Blue, Thickness[0.006]}, AxesLabel -> {"x","y"}, AspectRatio -> Automatic,options] decas[cpoly__, r_,s_, t_]:= Block[ {bb = cpoly, b = {}, m, i,j, lseg ={}, res}, (m = Length[bb]-1; Do[ Do[ b=Append[b, lerp[bb[[i]],bb[[i+1]], r,s,t]]; If[i>1, lseg = Append[lseg,{ b[[ i-1]], b[[i]]}]],{i,1,m-j+1}]; bb =b; b={},{j,1,m} ]; res:=Append[lseg, bb[[1]]]; res ) ]; pdecas[cpoly__, r_, s_, t_]:= Block[ {bb = cpoly, pt, ll, res, i,l1, edge}, res = decas[bb, r, s, t]; pt = Last[res]; l1 = Length[res]-1; ll={}; Do[ edge = res[[i]]; ll = Append[ll, Line[edge]], {i, 1, l1} ]; res = Append[{RGBColor[1,0,0], ll}, {RGBColor[0,0.2,0], PointSize[0.02], Point[pt]}]; res ]; gdecas[cpoly__,tt__, r_,s_]:= Block[ {bb = cpoly, b = {},t=tt, m, i,j, lseg ={}, res}, (m = Length[bb]-1; Do[ Do[ b=Append[b, lerp[bb[[i]],bb[[i+1]], r,s,t[[j]]]]; If[i>1, lseg = Append[lseg,{ b[[i-1]], b[[i]]}]],{i,1,m-j+1}]; bb =b; b={},{j,1,m} ]; res:=Append[lseg, bb[[1]]]; res ) ]; subdecas[cpoly__, r_, s_, t_]:= Block[ {bb = cpoly, b={}, ud={}, ld={}, m, i,j, res}, (m = Length[bb]-1; ud={bb[[1]]}; ld={bb[[m+1]]}; Do[ Do[ b = Append[b, lerp[bb[[i]],bb[[i+1]], r,s,t]], {i, 1, m - j + 1} ]; ud=Append[ud, b[[1]]]; ld=Prepend[ld, b[[m-j+1]]]; bb =b; b={}, {j, 1, m} ]; res := Join[{ud},{ld}]; res ) ]; subdivstep[{poly__},r_,s_]:= Block[ {cpoly={poly}, lpoly={}, t, l, i}, (l=Length[cpoly]; t=(r+s)/2; Do[ lpoly=Join[lpoly, subdecas[cpoly[[i]], r, s, t]], {i, 1,l} ]; lpoly ) ]; subdiv[{poly__}, r_, s_, n_]:= Block[ {pol1={poly}, newp={}, i}, ( newp={pol1}; Do[ newp=subdivstep[newp, r,s], {i, 1,n} ]; newp ) ]; bezieranimate2div[cpoly1__, cpoly__, ddpoly__, {x0_,x1_}, {y0_, y1_}, frame_] := Animate[Show[Graphics[{AbsoluteThickness[1], Line[ddpoly]}, AspectRatio -> Automatic, PlotRange -> {{x0, x1}, {y0, y1}}], Graphics[{AbsoluteThickness[0.5], Line[cpoly]}, AspectRatio -> Automatic, PlotRange -> {{ x0, x1}, {y0, y1}}], Graphics[{AbsoluteThickness[1], pdecas[cpoly1, 0, 1, (i - 1)/frame]}], Beziercurvegraphics[cpoly, 0, 1]], { i, 1, frame + 1, 1}, Frames -> frame] ＊＊＊＊＊ ＊＊＊＊＊ cpoly = {{-1, 1}, {0, -1}, {1, 1}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly1 = subdiv[cpoly, 0, 1, 1][[1]] ＊＊＊＊＊ ＊＊＊＊＊ cpoly2 = subdiv[cpoly, 0, 1, 1][[2]] ＊＊＊＊＊ ＊＊＊＊＊ ddpoly = Flatten[{cpoly1, cpoly2}, 1] ＊＊＊＊＊ ＊＊＊＊＊ bezieranimate2div[cpoly1, cpoly, ddpoly, {-1, 1}, {-1, 1}, 32] ＊＊＊＊＊ ＊＊＊＊＊ bezieranimate2div[cpoly2, cpoly, ddpoly, {-1, 1}, {-1, 1}, 32] ＊＊＊＊＊ 数回細分割するとベジエ曲線にほとんど一致することを確かめましょう． 与えられたベジエ多角形 ＊＊＊＊＊ C0 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 0], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ C1 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 1], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ C2 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 2], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ C3 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 3], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ C4 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 4], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ C5 = Show[ Graphics[{ AbsoluteThickness[ 0.5], Line[Flatten[subdiv[cpoly, 0, 1, 5], 1]]}, AspectRatio -> Automatic]] ＊＊＊＊＊ ＊＊＊＊＊ A0 = Bezierpoints[Beziercurve[cpoly, t] ] B0 = Beziercurvegraphicsnew[ A0, PlotPoints -> 50, PlotStyle -> {Thickness[0.003], Blue}, PlotRange -> All] Show[B0, C0, C1, C2, C3, C4,C5, Axes -> False] ＊＊＊＊＊ 次の場合にもベジエ曲線の細分割を考えましょう． ＊＊＊＊＊ cpoly := {{3, 2}, {-1, -3}, {-1, 3}, {3, -2}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly:={{3,2}, { -1, -2}, {-1,2}, {3,-2}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly:={{3,2}, { -1, -1}, {-1,1}, {3,-2}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly = {{0, 0}, {1, 6}, {11/2, 7}, {9, 3/2}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly = {{-1, -1 }, { - 1/3 , 1}, {1/3, -1}, {1, 1}} ＊＊＊＊＊ ＊＊＊＊＊ cpoly = {{-1, 0}, {1, 2}, {-1, 2}, {0, 3}, {1, 2}, {1, 0}, {-1, 2}, {-1, 0} } ＊＊＊＊＊