正四面体に4つの球を内接させる
課題
正四面体を作成する。下図のように、その正四面体に内接し、互いに外接する4つの球を描け。
見本アプレット
https://www.geogebra.org/m/xgbxzwgq
今回は、まずは3面に内接するように球を作成し、パラメータを調節することで、球同士を外接させる、というアプローチで作成してみた。
作成手順
正四面体を作成する
自由な点A,Bを、グラフィックスビュー1上に作成する。
正四面体の底面となる正三角形bottomを、以下の定義で作成する*1。
bottom = Element[{Polygon[A, B, 3, xOy平面]}, 1]
底面bottomの3頂点からなるリストbottomVerticeを、以下の定義で作成する。
bottomVertice = {Vertex[bottom]}
底面bottomの重心bottomCentroidを、以下の定義で作成する。
bottomCentroid = Centroid[bottom]
正四面体tetraを、以下の定義で作成する*2。
tetra = Element[{Tetrahedron[bottom, true]}, 1]
正四面体tetraの頂点Topを、以下の定義で作成する。
Top = Translate[bottomCentroid, Vector[(0, 0, Height[tetra])]]
正四面体tetraの4頂点からなるリストtetraVerticeを、以下の定義で作成する。
tetraVertice = Join[{bottomVertice, {Top}}]
4つの球を作成する
正四面体tetraの4面のそれぞれの重心からなるリストcentroidsを、以下の定義で作成する。
centroids = {Centroid[Polygon[Element[tetraVertice, 2], Element[tetraVertice, 3], Element[tetraVertice, 4]]], Centroid[Polygon[Element[tetraVertice, 3], Element[tetraVertice, 4], Element[tetraVertice, 1]]], Centroid[Polygon[Element[tetraVertice, 4], Element[tetraVertice, 1], Element[tetraVertice, 2]]], Centroid[Polygon[Element[tetraVertice, 1], Element[tetraVertice, 2], Element[tetraVertice, 3]]]}
頂点と、対面の重心とを結んだ線分のリストsegsを、以下の定義で作成する。
segs = Zip[Segment[α, β], α, tetraVertice, β, centroids]
数値オブジェクトparamを、範囲0〜1で作成し、スライダーを作成する。
パス・パラメータがparamであるような、segs上の点リストcoresを、以下の定義で作成する。
cores = Zip[Point[γ, param], γ, segs]
球の半径radiusは、以下のように表されるので、これを作成する。
radius = z(Element[cores, 1])
4つの球リストsprsを、以下の定義で作成する。
球同士が外接するときのparamの値を求める
球同士が外接するときのparamの値を求めて、paramをその値にすれば、目的の図を描くことができる。その値は、計算によって求めることも可能だが、今回はせっかくなので、GeoGebraに計算してもらおう。
点A側の球Element[sprs, 1]上の点のうち、点B側の球の中心Element[cores, 2]に最も近い点Pを、以下の定義で作成する。
P = ClosestPointRegion[Element[sprs, 1], Element[cores, 2]]
点B側の球Element[sprs, 2]上の点のうち、点A側の球の中心Element[cores, 1]に最も近い点Qを、以下の定義で作成する。
Q = ClosestPointRegion[Element[sprs, 2], Element[cores, 1]]
球同士が外接するならば、Distance[P,Q]は0である。
paramとDistance[P,Q]との関係を調べよう。そのために、x軸にparam、y軸にDistance[P,Q]をとったときのグラフを考えよう。当該グラフ上の点graphPointは、
graphPoint = (param, Distance[P, Q])
と表せる。
Locus[graphPoint,param]
によって、グラフを描いてみると、下図のようになる。
param = 0.53あたりで、球が外接することがわかる。証明は省略するが、paramが0から0.53あたりまで増加するに伴って、Distance[P, Q]は単調減少する。そこで、今回は、これを利用して、球が外接するときのparamの値を計算することにしよう。
graphPointの定義式を、paramに依存するオブジェクト名を用いずに、直接paramを用いて表すと、以下のようになる（graphPointNested）。
graphPointNested = (param, Distance[ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, param], γ, segs], 1]]], δ, Zip[Point[γ, param], γ, segs]], 1], Element[Zip[Point[γ, param], γ, segs], 2]], ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, param], γ, segs], 1]]], δ, Zip[Point[γ, param], γ, segs]], 2], Element[Zip[Point[γ, param], γ, segs], 1]]])
param=0におけるgraphPointの値は、graphPointNestedの定義式における「param」を、「0」に置換することによって得られる（graphPoint00）。
graphPoint00 = (0, Distance[ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, 0], γ, segs], 1]]], δ, Zip[Point[γ, 0], γ, segs]], 1], Element[Zip[Point[γ, 0], γ, segs], 2]], ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, 0], γ, segs], 1]]], δ, Zip[Point[γ, 0], γ, segs]], 2], Element[Zip[Point[γ, 0], γ, segs], 1]]])
同様に、param=0.5におけるgraphPointの値をもつ点として、graphPoint05を作成する。
graphPoint05 = (0.5, Distance[ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, 0.5], γ, segs], 1]]], δ, Zip[Point[γ, 0.5], γ, segs]], 1], Element[Zip[Point[γ, 0.5], γ, segs], 2]], ClosestPointRegion[Element[Zip[Sphere[δ, z[Element[Zip[Point[γ, 0.5], γ, segs], 1]]], δ, Zip[Point[γ, 0.5], γ, segs]], 2], Element[Zip[Point[γ, 0.5], γ, segs], 1]]])
求めるparamの値は、Line[graphPoint00, graphPoint05]とx軸との交点AnsPointの、x座標の値に等しい。
AnsPoint = Intersect[Line[graphPoint00, graphPoint05], x軸]
ボタンを作成し、On Click スクリプトに、以下を記述する。
SetValue[param,x(AnsPoint)]
ボタンをクリックすると、4つの球が互いに外接するように、paramの値が調整される。
