最初にいくつかの分析を行いましょう。
多角形内で、その確率密度が比例関数 次に、比例定数は、ポリゴン上のの積分の逆数です。Pp(x,y).p
μ0,0(P)=∬Pp(x,y)dxdy.
ポリゴンの重心は、最初のモーメントとして計算される平均座標のポイントです。最初は
μ1,0(P)=1μ0,0(P)∬Pxp(x,y)dxdy.
慣性テンソルは、第二モーメントの対称的なアレイが原点にその重心を置くためにポリゴンを変換した後に計算されるように表すことができる：、の行列である中央の第二モーメント
μ′k,l(P)=1μ0,0(P)∬P(x−μ1,0(P))k(y−μ0,1(P))lp(x,y)dxdy
ここで、範囲はからから テンソル自体（別名共分散行列）は、(k,l)(2,0)(1,1)(0,2).
I(P)=(μ′2,0(P)μ′1,1(P)μ′1,1(P)μ′0,2(P)).
のPCAは、主軸を生成しますこれらは、固有値でスケーリングされた単位固有ベクトルです。I(P)P:
次に、計算方法を考えてみましょう。 多角形は、その方向付けられた境界を記述する一連の頂点として提示されるため、呼び出すのは自然です∂P,
グリーンの定理： whereは、と近傍で定義された1つの形式です∬Pdω=∮∂Pω
ω=M(x,y)dx+N(x,y)dyPdω=(∂∂xN(x,y)−∂∂yM(x,y))dxdy.
たとえば、と定数（つまり、均一）密度場合、（検査により）多くの1つを選択できますなどの解dω=xkyldxdyp,ω(x,y)=−1l+1xkyl+1dx.
これのポイントは、等高線積分が一連の頂点によって決定される線分セグメントに従うことです。頂点から頂点までの任意のラインセグメントは、次の形式の実数変数によってパラメーター化できます。uvt
t→u+tw
ここで、は、からへの単位法線方向値、したがって範囲に このパラメータ化では、とは線形関数であり、とは線形関数です したがって、各エッジの輪郭積分の被積分関数は多項式関数になり、小さいとw∝v−uuv.t0|v−u|.xytdxdydt.t,kl.
この分析の実装は、そのコンポーネントのコーディングと同じくらい簡単です。最低レベルでは、多項式1フォームを線分セグメントに統合する関数が必要です。より高いレベルの関数は、これらを集約して生および中心モーメントを計算して、重心および慣性テンソルを取得します。最後に、そのテンソルを操作して主軸（スケーリングされた固有ベクトル）を見つけることができます。R以下のコードはこの作業を実行します。それは効率のふりをしません：それは前述の分析の実際の応用を説明することだけを目的としています。各関数は単純であり、命名規則は分析のものに対応しています。
コードに含まれているのは、有効な閉じた、単純に接続された、自己交差しないポリゴンを生成する手順です（円に沿って点をランダムに変形し、閉じたループを作成するために開始点をその最終点として含めます）。これに続いて、ポリゴンをプロットし、その頂点を表示し、重心に隣接し、主軸を赤（最大）と青（最小）でプロットして、ポリゴン中心の正の方向の座標系を作成するいくつかのステートメントを次に示します。
#
# Integrate a monomial one-form x^k*y^l*dx along the line segment given as an
# origin, unit direction vector, and distance.
#
lintegrate <- function(k, l, origin, normal, distance) {
# Binomial theorem expansion of (u + tw)^k
expand <- function(k, u, w) {
i <- seq_len(k+1)-1
u^i * w^rev(i) * choose(k,i)
}
# Construction of the product of two polynomials times a constant.
omega <- normal[1] * convolve(rev(expand(k, origin[1], normal[1])),
expand(l, origin[2], normal[2]),
type="open")
# Integrate the resulting polynomial from 0 to `distance`.
sum(omega * distance^seq_along(omega) / seq_along(omega))
}
#
# Integrate monomials along a piecewise linear path given as a sequence of
# (x,y) vertices.
#
cintegrate <- function(xy, k, l) {
n <- dim(xy)[1]-1 # Number of edges
sum(sapply(1:n, function(i) {
dv <- xy[i+1,] - xy[i,] # The direction vector
lambda <- sum(dv * dv)
if (isTRUE(all.equal(lambda, 0.0))) {
0.0
} else {
lambda <- sqrt(lambda) # Length of the direction vector
-lintegrate(k, l+1, xy[i,], dv/lambda, lambda) / (l+1)
}
}))
}
#
# Compute moments of inertia.
#
inertia <- function(xy) {
mass <- cintegrate(xy, 0, 0)
barycenter = c(cintegrate(xy, 1, 0), cintegrate(xy, 0, 1)) / mass
uv <- t(t(xy) - barycenter) # Recenter the polygon to obtain central moments
i <- matrix(0.0, 2, 2)
i[1,1] <- cintegrate(uv, 2, 0)
i[1,2] <- i[2,1] <- cintegrate(uv, 1, 1)
i[2,2] <- cintegrate(uv, 0, 2)
list(Mass=mass,
Barycenter=barycenter,
Inertia=i / mass)
}
#
# Find principal axes of an inertial tensor.
#
principal.axes <- function(i.xy) {
obj <- eigen(i.xy)
t(t(obj$vectors) * obj$values)
}
#
# Construct a polygon.
#
circle <- t(sapply(seq(0, 2*pi, length.out=11), function(a) c(cos(a), sin(a))))
set.seed(17)
radii <- (1 + rgamma(dim(circle)[1]-1, 3, 3))
radii <- c(radii, radii[1]) # Closes the loop
xy <- circle * radii
#
# Compute principal axes.
#
i.xy <- inertia(xy)
axes <- principal.axes(i.xy$Inertia)
sign <- sign(det(axes))
#
# Plot barycenter and principal axes.
#
plot(xy, bty="n", xaxt="n", yaxt="n", asp=1, xlab="x", ylab="y",
main="A random polygon\nand its principal axes", cex.main=0.75)
polygon(xy, col="#e0e0e080")
arrows(rep(i.xy$Barycenter[1], 2),
rep(i.xy$Barycenter[2], 2),
-axes[1,] + i.xy$Barycenter[1], # The -signs make the first axis ..
-axes[2,]*sign + i.xy$Barycenter[2],# .. point to the right or down.
length=0.1, angle=15, col=c("#e02020", "#4040c0"), lwd=2)
points(matrix(i.xy$Barycenter, 1, 2), pch=21, bg="#404040")
