実習：空間の線形変換

A={{1,0,0},{0,1,0},{0,0,1}};
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]},Boxed->False
],
Graphics3D[{
{PointSize[Large],Point[{a,b,c}]},Text["p",{a,b,c}+{0,0,1.5}],
{PointSize[Large],Point[A.{a,b,c}]},Text["Ap",A.{a,b,c}-{0,0,2}]
}]
],
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]

1. 一般形

立方体の面のデータ

P1:=5*{{0,0,0},{1,0,0},{1,1,0},{0,1,0},{0,0,0}};
P6:=5*{{0,0,1},{1,0,1},{1,1,1},{0,1,1},{0,0,1}};
P2:=5*{{0,0,0},{1,0,0},{1,0,1},{0,0,1},{0,0,0}};
P4:=5*{{0,1,0},{1,1,0},{1,1,1},{0,1,1},{0,1,0}};
P3:=5*{{0,0,0},{0,1,0},{0,1,1},{0,0,1},{0,0,0}};
P5:=5*{{1,0,0},{1,1,0},{1,1,1},{1,0,1},{1,0,0}};

立方体の描画

Graphics3D[{Polygon[P1],Polygon[P2],Polygon[P3],Polygon[P4],Polygon[P5],Polygon[P6]}]

立方体を線形変換する

M[a11_,a12_,a13_,a21_,a22_,a23_,a31_,a32_,a33_]:=(({{a11, a12, a13}, {a21, a22, a23}, {a31, a32, a33}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]},Boxed->False
],
Graphics3D[{
Polygon[P1.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Polygon[P2.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Polygon[P3.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Polygon[P4.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Polygon[P5.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Polygon[P6.Transpose[M[a1,a2,a3,b1,b2,b3,c1,c2,c3]]],
Text[M[a1,a2,a3,b1,b2,b3,c1,c2,c3],{-15,-15,15}]}]
],
Style["行列の第1列の成分",12,Bold],
{{a1,1,"第1行"},-4,4},{{b1,0,"第2行"},-4,4},{{c1,0,"第3行"},-4,4},
Delimiter,Style["行列の第1列の成分",12,Bold],
{{a2,0,"第1行"},-4,4},{{b2,1,"第2行"},-4,4},{{c2,0,"第3行"},-4,4},
Delimiter,Style["行列の第1列の成分",12,Bold],
{{a3,0,"第3行"},-4,4},{{b3,0,"第3行"},-4,4},{{c3,1,"第3行"},-4,4},
SaveDefinitions->True, ControlPlacement->Left
]

2.1. 回転(1)

Rz[s_]:=(({{Cos[s], -Sin[s], 0}, {Sin[s], Cos[s], 0}, {0, 0, 1}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]}
],
Graphics3D[
{Text["p",{a,b,c}+{0,0,1.5}],{PointSize[Large],Point[{a,b,c}]},
Text["Ap",Rz[s].{a,b,c}-{0,0,2}],{PointSize[Large],Point[Rz[s].{a,b,c}]},
{Blue,Line[{{0,0,c},{a,b,c}}]},{Blue,Line[{{0,0,c},Rz[s].{a,b,c}}]}
}
],
ParametricPlot3D[Rz[t].{a,b,c},{t,0,2Pi}]
],
{{s,Pi/4,"回転角"},0,2Pi},
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]

2.2. 回転(2)

Rx[s_]:=(({{1, 0, 0}, {0, Cos[s], -Sin[s]}, {0, Sin[s], Cos[s]}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]}
],
Graphics3D[
{Text["p",{a,b,c}+{0,0,1.5}],{PointSize[Large],Point[{a,b,c}]},
Text["Ap",Rx[s].{a,b,c}-{0,0,2}],{PointSize[Large],Point[Rx[s].{a,b,c}]},
{Blue,Line[{{a,0,0},{a,b,c}}]},{Blue,Line[{{a,0,0},Rx[s].{a,b,c}}]}
}
],
ParametricPlot3D[Rx[t].{a,b,c},{t,0,2Pi}]
],
{{s,Pi/4,"回転角"},0,2Pi},
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]

2.3. 回転(3)

Ry[s_]:=(({{Sin[s], 0, Cos[s]}, {0, 1, 0}, {Cos[s], 0, -Sin[s]}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]}
],
Graphics3D[
{Text["p",{a,b,c}+{0,0,1.5}],{PointSize[Large],Point[{a,b,c}]},
Text["Ap",Ry[s].{a,b,c}-{0,0,2}],{PointSize[Large],Point[Ry[s].{a,b,c}]},
{Blue,Line[{{0,b,0},{a,b,c}}]},{Blue,Line[{{0,b,0},Ry[s].{a,b,c}}]}
}
],
ParametricPlot3D[Ry[t].{a,b,c},{t,0,2Pi}]
],
{{s,Pi/4,"回転角"},0,2Pi},
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]

2.4. 回転(4)

ax[u_,v_]:=Cos[u]*Cos[v];
ay[u_,v_]:=Sin[u]*Cos[v];
az[u_,v_]:=Sin[v];R3[s_][u_,v_]:=(({{Cos[s]+(1-Cos[s])*(ax[u,v])^2, (1-Cos[s])*ax[u,v]*ay[u,v]-az[u,v]*Sin[s], (1-Cos[s])*ax[u,v]*az[u,v]+ay[u,v]*Sin[s]}, {(1-Cos[s])*ax[u,v]*ay[u,v]+az[u,v]*Sin[s], Cos[s]+(1-Cos[s])*(ay[u,v])^2, (1-Cos[s])*ay[u,v]*az[u,v]-ax[u,v]*Sin[s]}, {(1-Cos[s])*ax[u,v]*az[u,v]-ay[u,v]*Sin[s], (1-Cos[s])*ay[u,v]*az[u,v]+ax[u,v]*Sin[s], Cos[s]+(1-Cos[s])*(az[u,v])^2}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]}
],
ParametricPlot3D[R3[w][u[1],u[2]].{a,b,c},{w,0,2Pi}],
Graphics3D[
{{Blue,Line[{{a,b,c}/2+R3[Pi][u[[1]],u[[2]]].{a,b,c}/2,{a,b,c}}]},
{Blue,Line[{{a,b,c}/2+R3[Pi][u[[1]],u[[2]]].{a,b,c}/2,R3[s][u[[1]],u[[2]]].{a,b,c}}]}}
],
Graphics3D[
{{PointSize[Large],Point[{a,b,c}]},Text["p",{a,b,c}+{0,0,1.5}],
{PointSize[Large],Point[R3[s][u[[1]],u[[2]]].{a,b,c}]}},Text["Ap",R3[s][u[[1]],u[[2]]].{a,b,c}-{0,0,2}]
],
Graphics3D[{Thick,Dashed,Red,Line[{-20*{ax[u[[1]],u[[2]]],ay[u[[1]],u[[2]]],az[u[[1]],u[[2]]]},20*{ax[u[[1]],u[[2]]],ay[u[[1]],u[[2]]],az[u[[1]],u[[2]]]}}]}],
ParametricPlot3D[R3[w][u[[1]],u[[2]]].{a,b,c},{w,0,2Pi}]
],
{{u,{Pi/4,Pi/4},"回転軸"},{0,0},{2Pi,Pi/2}},
Delimiter,{{s,Pi/4,"回転角"},0,2Pi},
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]

3. 空間内の平面に関する鏡映

ax[u_,v_]:=Cos[u]*Cos[v];
ay[u_,v_]:=Sin[u]*Cos[v];
az[u_,v_]:=Sin[v];
S3[u_,v_]:=(({{1-2ax[u,v]^2, -2ax[u,v]*ay[u,v], -2ax[u,v]*az[u,v]}, {-2ax[u,v]*ay[u,v], 1-2ay[u,v]^2, -2ay[u,v]*az[u,v]}, {-2ax[u,v]*az[u,v], -2ay[u,v]*az[u,v], 1-2az[u,v]^2}}));
Manipulate[
Show[
Graphics3D[
{Arrow[{{-20,0,0},{20,0,0}}],Text["x軸",{21.5,0,0}],
Arrow[{{0,-20,0},{0,20,0}}],Text["y軸",{0,21.5,0}],
Arrow[{{0,0,-20},{0,0,20}}],Text["z軸",{0,0,21.5}]}
],
Graphics3D[
{Text["p",{a,b,c}+{0,0,1.5}],{PointSize[Large],Point[{a,b,c}]},
Text["Ap",S3[u[[1]],u[[2]]].{a,b,c}-{0,0,2}],{PointSize[Large],Point[S3[u[[1]],u[[2]]].{a,b,c}]}}
],
ContourPlot3D[ax[u[[1]],u[[2]]]*X+ay[u[[1]],u[[2]]]*Y+az[u[[1]],u[[2]]]*Z==0,
{X,-21.5,21.5},{Y,-21.5,21.5},{Z,-21.5,21.5},Mesh->None,ContourStyle->Directive[Orange,Opacity[0.5]]
],
Graphics3D[{Blue,Thick,Arrow[{{0,0,0},8{ax[u[[1]],u[[2]]],ay[u[[1]],u[[2]]],az[u[[1]],u[[2]]]}}]}]
],
Delimiter,Style["平面の法線ベクトル",12,Bold],
{{u,{Pi/4,Pi/4},"方向"},{0,0},{2Pi,Pi/2}},
Delimiter,Style["点pの成分",12,Bold],
{{a,5,"第1成分"},-10,10},{{b,5,"第2成分"},-10,10},{{c,5,"第3成分"},-10,10},
SaveDefinitions->True, ControlPlacement->Left
]