让我们先做一些分析。
假设在多边形P其概率密度为比例函数p(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,很自然地调用
格林定理: ∬Pdω=∮∂Pω
,其中ω=M(x,y)dx+N(x,y)dy是在的邻域定义的一个形式的P和dω=(∂∂xN(x,y)−∂∂yM(x,y))dxdy.
例如,对于dω=xkyldxdy和恒定(即,均匀的)密度p,我们可以(通过检查)选择了许多解决方案,诸如一个ω(x,y)=−1l+1xkyl+1d X。
这样做的目的是轮廓积分遵循由顶点序列确定的线段。顶点ü到顶点v任何线段都可以由实变量Ť进行参数化,形式为
t → u + t w
其中w ^ α v - ü是从ü到v。的单位法线方向。因此,Ť范围是0到| v − u | 。 根据这一参数X和ÿ是线性函数Ť和d X和d ÿ是线性函数d吨。 因此在每个边缘轮廓积分的积变为多项式函数的牛逼,很容易评估ķ和 l小。l 。
实施此分析就像对其组件进行编码一样简单。在最低级别,我们将需要一个函数将一个线段上的多项式一形式积分。更高级别的函数将汇总这些矩以计算原始矩和中心矩,以获得重心和惯性张量,最后,我们可以在该张量上进行操作以找到主轴(即缩放后的特征向量)。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")