================
Rational Bezier２
================
Mathematicaを用いた練習を行います。

Mathematica　は毎回使いますから、ＧＮＯＭＥパネルの
ランチャーに登録しておきましょう。
Mathematica は
「センターメニュー」-「アプリケーション」-「Mathematic数式処理」
にあります。


適当にプログラムの中の数字などを変更して試してみてください。

以下の説明の中で＊＊＊＊＊ではさまれた部分は
Mathematica　に入力する文字列です。自分で入力し
Shift+Enter(Return) キーで実行します。
上から順に，すべて実行するようにしてください。
上で定義した関数を後で利用すること 
があります。

前回の有理ベジエ曲線の復習から始めます。

ベジエ曲線を用いて、絵を描いてみましたが、
３点から定まるベジエ曲線は常に放物線でした。

では、円、楕円や双曲線を描くにはどうすればいいのでしょうか？
これを解決するために、重みの概念が考えられました。

重みを変化させるとどのように曲線が変化するかをみましょう。

 
 ＊＊＊＊＊＊
Needs["Graphics`Colors`"]

Cn[s_] := n!/(s!*(n - s)!)
Bn[s_, u_] := Cn[s]*(u^s)*((1 - u)^(n - s))
SS[n_] := Sum[b[j]*Bn[j, t], {j, 0, n}]
AA[n_] := Sum[w[j]*b[j]*Bn[j, t], {j, 0, n}]/Sum[w[j]*Bn[j, t], {j, 0, n}]
L[n_] := Table[(1 - t)*b[i] + t*b[i + 1], {i, 0, n - 1}]

RatBezCurve2[a_, b_][pt_, color_] := 
  ParametricPlot[Evaluate[AA[n]], {t, a, b}, AspectRatio -> Automatic, 
    Axes -> True, PlotRange -> All, PlotStyle -> {Thickness[pt], color}]
B2Poly := 
  ParametricPlot[Evaluate[L[n]], {t, 0, 1}, AspectRatio -> Automatic, 
    Axes -> True, PlotStyle -> {Thickness[0.005]}]
RatBezPloy2[a_, b_] := Show[RatBezCurve2[a, b], B2Poly]
＊＊＊＊＊＊
 
 w[0], w[1], w[2]　が重みです。
まず放物線を描きましょう。
このときは、重みはどれも１です。
＊＊＊＊＊＊
n = 2
b[0] = {-1, 1}
b[1] = {0, -1}
b[2] = {1, 1}
w[0]=1
w[1]=1
w[2]=1
pa1=RatBezCurve2[-1/2, 3/2][ 0.005, Black]
＊＊＊＊＊＊

次に、重みを変えてみましょう。

＊＊＊＊＊＊
w[0] = 1
w[1] = 1
w[2] = 3
cir1 = RatBezCurve2[-1/2, 3/2][0.005, Red]
＊＊＊＊＊＊

＊＊＊＊＊＊
w[0] = 1
w[1] = 1
w[2] = 1/3
hyp1 = RatBezCurve2[-.35, 1.1][0.005, Blue]
＊＊＊＊＊＊

＊＊＊＊＊＊
Show[pa1, cir1, hyp1]
＊＊＊＊＊＊

別の３点をとってみましょう。
＊＊＊＊＊＊
n = 2
b[0] = {1, 0}
b[1] = {1, 1}
b[2] = {0, 1}
＊＊＊＊＊＊

＊＊＊＊＊＊
w[0] = 1
w[1] = 1
w[2] = 1
pa2 = RatBezCurve2[-1/2, 3/2][0.005, Black]


w[0] = 1
w[1] = 1
w[2] = 2
cir2 = RatBezCurve2[-1/2, 3/2][0.005, Red]

w[0] = 1
w[1] = 1
w[2] = 1/2
hyp2 = RatBezCurve2[-.2, 1.1][0.005, Blue]
＊＊＊＊＊＊

＊＊＊＊＊＊
Show[pa2, cir2, hyp2]
＊＊＊＊＊＊

＊＊＊＊＊＊
n = 2
b[0] = {1, 0}
b[1] = {0, 3^(1/2)}
b[2] = {-1, 0}
w[0] = 1
w[1] = 1/3
w[2] = 1
cir22 = RatBezCurve2[-1/2, 3/2][0.01, Red]
Show[cir22, B2Poly]
＊＊＊＊＊＊

＊＊＊＊＊＊
n = 2
b[0] = {1, 0}
b[1] = {0, 3^(1/2)}
b[2] = {-1, 0}
w[0] = 1
w[1] = 2
w[2] = 1
hyper22 = RatBezCurve2[-1/10, 10/9][0.01, Red]
Show[hyper22, B2Poly]
＊＊＊＊＊＊

＊＊＊＊＊＊
n = 2
b[0] = {1, 0}
b[1] = {0, 3^(1/2)}
b[2] = {-1, 0}
w[0] = 1
w[1] = 1/2
w[2] = 1
Cir1 = RatBezCurve2[0, 1][0.01, Red]
b[0] = {-1, 0}
b[1] = {-2, -3^(1/2)}
b[2] = {0, -3^(1/2)}
w[0] = 1
w[1] = 1/2
w[2] = 1
Cir2 = RatBezCurve2[0, 1][0.01, Blue]
b[0] = {0, -3^(1/2)}
b[1] = {2, -3^(1/2)}
b[2] = {1, 0}
w[0] = 1
w[1] = 1/2
w[2] = 1
Cir3 = RatBezCurve2[0, 1][0.01, Brown]
Show[Cir1, Cir2, Cir3]
＊＊＊＊＊＊


４点以上をとって、重みをいろいろと変えて
どのように変化するかを確かめてみましょう。


デカルトの葉線をかいてみましょう。
＊＊＊＊＊＊
n = 3
b[0] = {0, 0}
b[1] = {1, 0} 
b[2] = {2, 1}
b[3] = {3/2, 3/2}
w[0] = 1
w[1] = 1
w[2] = 1
w[3] = 2
deca1 = RatBezCurve2[-1/2, 1][0.005, Red]
b[0] = {0, 0}
b[1] = {0, 1} 
b[2] = {1, 2}
b[3] = {3/2, 3/2}
w[0] = 1
w[1] = 1
w[2] = 1
w[3] = 2
deca2 = RatBezCurve2[-1/2, 1][0.005, Red]
Show[deca1, deca2]
＊＊＊＊＊＊


次にアステロイドを描いてみましょう。
＊＊＊＊＊＊
n = 6
b[0] = {0, 1}
b[1] = {0, 1}
b[2] = {0, 2/3}
b[3] = {1/4, 1/4}
b[4] = {2/3, 0}
b[5] = {1, 0}
b[6] = {1, 0}

w[0] = 1
w[1] = 1
w[2] = 6/5
w[3] = 8/5
w[4] = 12/5
w[5] = 4
w[6] = 8 
Evaluate[AA[n]]
aste1 = RatBezCurve2[-1/2, 2][0.01, Red]
b[0] = {0, 1}
b[1] = {0, 1}
b[2] = {0, 2/3}
b[3] = {-1/4, 1/4}
b[4] = {-2/3, 0}
b[5] = {-1, 0}
b[6] = {-1, 0}
aste2 = RatBezCurve2[0, 1][0.01, Red]
b[0] = {0, -1}
b[1] = {0, -1}
b[2] = {0, -2/3}
b[3] = {-1/4, -1/4}
b[4] = {-2/3, 0}
b[5] = {-1, 0}
b[6] = {-1, 0}
aste3 = RatBezCurve2[0, 1][0.01, Red]
b[0] = {0, -1}
b[1] = {0, -1}
b[2] = {0, -2/3}
b[3] = {1/4, -1/4}
b[4] = {2/3, 0}
b[5] = {1, 0}
b[6] = {1, 0}
aste4 = RatBezCurve2[0, 1][0.01, Red]
＊＊＊＊＊＊

＊＊＊＊＊＊
Show[aste1, aste2, aste3, aste4]
＊＊＊＊＊＊

ここで、一度ファイルを保存（save）してください。

 Mathematica から一度出ましょう。
 
 再び Mathematica  を立ち上げて下さい。
 
 
 ハートを重みをつけて少し変えてみましょう。
 
 ＊＊＊＊＊＊
 Needs["Graphics`Colors`"]


Cn[s_]:=n!/(s!*(n-s)!)
Bn[s_,u_]:=Cn[s]*(u^s)*((1-u)^(n-s))
SS[n_]:=Sum[b[j]*Bn[j,t],{j,0,n}]
AA[n_]:=Sum[w[j]*b[j]*Bn[j,t],{j,0,n}]/Sum[w[j]*Bn[j,t],{j,0,n}]
L[n_]:=Table[(1-t)*b[i]+t*b[i+1],{i,0,n-1}]
B2Poly:=ParametricPlot[Evaluate[L[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False]
RatBezCurve2[a_,b_][pt_,color_]:=
  ParametricPlot[Evaluate[AA[n]],{t,a,b},AspectRatio\[Rule]Automatic,
    Axes\[Rule]True,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[pt],color}]
BlueBezier:=
  ParametricPlot[Evaluate[SS[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[0.02],Blue}]
RedBezier:=
  ParametricPlot[Evaluate[SS[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[0.02],Red}]
GreenBezier:=
  ParametricPlot[Evaluate[SS[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[0.02],Green}]
OrangeBezier:=
  ParametricPlot[Evaluate[SS[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[0.02],Orange}]
BlackBezier:=
  ParametricPlot[Evaluate[SS[n]],{t,0,1},AspectRatio\[Rule]Automatic,
    Axes\[Rule]False,PlotRange\[Rule]All,
    PlotStyle\[Rule]{Thickness[0.02],Black}]
＊＊＊＊＊＊


ハートを描いてみましょう。

＊＊＊＊＊＊
n=8
b[0]={0,1/2};
b[1]={0,0.7};
b[2]={2.5,3.5};
b[3]={2.5,4};
b[4]={2.5,4.7};
b[5]={2,5.5};
b[6]={1/2,5.5};
b[7]={0,5};
b[8]={0,4};
w[0]=5;
w[1]=4;
w[2]=3;
w[3]=2;
w[4]=1;
w[5]=2;
w[6]=3;
w[7]=4;
w[8]=5;

c1=RedBezier
b1=B2Poly
b[0]={0,1/2};
b[1]={0,.7};
b[2]={-2.5,3.5};
b[3]={-2.5,4};
b[4]={-2.5,4.7};
b[5]={-2,5.5};
b[6]={-1/2,5.5};
b[7]={0,5};
b[8]={0,4};
c2=RedBezier
b2=B2Poly
d2=RatBezCurve2[0,1][0.01,Blue]
Show[c1,d2]

Show[c1,d2,b1,b2]
＊＊＊＊＊＊


ハートに色をぬりましょう。

＊＊＊＊＊＊
n=8;
b[0]={0,1/2};
b[1]={0,0.7};
b[2]={2.5,3.5};
b[3]={2.5,4};
b[4]={2.5,4.7};
b[5]={2,5.5};
b[6]={1/2,5.5};
b[7]={0,5};
b[8]={0,4};
cc1=SS[n];
b[0]={0,1/2};
b[1]={0,.7};
b[2]={-2.5,3.5};
b[3]={-2.5,4};
b[4]={-2.5,4.7};
b[5]={-2,5.5};
b[6]={-1/2,5.5};
b[7]={0,5};
b[8]={0,4};
dd2=AA[n];
＊＊＊＊＊＊

＊＊＊＊＊＊
filledcurve[curve_,{u_,u0_,u1_},Color_, CCC_]:=
  Module[{plottmp,grtmp},
    plottmp=ParametricPlot[curve//Evaluate,{u,u0,u1},
        AspectRatio\[Rule]Automatic,DisplayFunction\[Rule]Identity];
    grtmp=plottmp/.(Line[pts_]\[RuleDelayed]Polygon[pts]);
    Show[grtmp,DisplayFunction\[Rule]$DisplayFunction,Axes\[Rule]False,
      PlotRange\[Rule]All,DefaultColor\[Rule]Color, Background\[Rule]CCC]]
＊＊＊＊＊＊

＊＊＊＊＊＊
filledcurve[{cc1,dd2},{t,0,1},Red, White]
＊＊＊＊＊＊


filledcurve[{cc1,dd2},{t,-0,1},Red, RGBColor[.7,0.9,0.9]]

filledcurve[{cc1,dd2},{t,-0,1},RGBColor[1.`,1.`,0.`],RGBColor[1.`,0.`,0.`]]