使用 Procrustes 分析比较两个 3D 点云的形状

Question

我有两个三维点云。我想比较它们的形状和范围。我认为普罗克拉斯特分析是正确的选择。我已经安装了“ shapes ”包，它提供了几种类型的Procrustes Analysis，例如通用Procrustes Analysis (GPA)。我想，我在这里遗漏了一些东西。我期待的是一个函数，我将两个 3D 矩阵传递给它，它会返回一个关于它们匹配/关联程度的值，例如 0 - 1 之间的值。类似于：

procrustes.distance(A,B) # A and B each being 3x100 

基本上就像Matlab 中的procrustes一样。

Answer 1

感谢 Julien Claude 的书，Morphometrics with R我们有了一些方便的代码来完成与 matlab 函数相同的操作。

他提供了一些函数来计算完整的 Procrustes 距离，他将其定义为“叠加配置的同源坐标之间的距离平方和的平方根（之前缩放到单位大小）”，正如 matlab 函数的定义一样。

# first, scale the coordinates to unit centroid size, and return both the scaled coords and the centroid size

centsiz<-function(M)
       {p<-dim(M)[1]
         size<-sqrt(sum(apply(M, 2,var))*(p-1))
         list("centroid_size" = size,"scaled" = M/size)}

# second, translate the coords so that its centroid is set at the origin

trans1<-function(M){scale(M,scale=F)}

# third, prepare the fPsup function to perform the full Procrustes superimposition of M1 onto M2. In the output, DF is the Full Procrustes distance between M1 and M2.

fPsup<-function(M1, M2) { 
       k<-ncol(M1)
          Z1<-trans1(centsiz(M1)[[2]])
          Z2<-trans1(centsiz(M2)[[2]])
          sv<-svd(t(Z2)%*%Z1)
          U<-sv$v; V<-sv$u; Delt<-sv$d
          sig<-sign(det(t(Z2)%*%Z1))
          Delt[k]<-sig*abs(Delt[k]) ; V[,k]<-sig * V[,k]
          Gam<-U%*%t(V)
          beta<-sum(Delt)
          list(Mp1=beta*Z1%*%Gam,Mp2=Z2,rotation=Gam,scale=beta,
                  DF=sqrt(1-beta^2))}

# test it out...
library(shapes) # so we can use the built-in data
data(gorf.dat) # Female gorilla skull data, 8 landmarks in 2 dimensions, 30 individuals

# calculate procrustes distance for individuals 1 and 2
fPsup(gorf.dat[,,1], gorf.dat[,,2])$DF
[1] 0.0643504

# Claude provides a check with a function that calculates the interlandmark distances between two configurations, which we can then sqrt the sum of to get the matlab-defined procrustes distance. 

ild2<-function(M1, M2){sqrt(apply((M1-M2)^2, 1, sum))}

# test it out...
test<-fPsup(gorf.dat[,,1], gorf.dat[,,2])
test$DF
[1] 0.0643504
sqrt(sum(ild2(test$Mp1, test$Mp2)^2))
[1] 0.0643504 # the same

如果您只想坚持使用该shapes包，黎曼形状距离函数计算几乎相同的结果：

library(shapes)
riemdist(gorf.dat[,,1], gorf.dat[,,2])
[1] 0.0643949

更新我与该包的作者 Ian Dryden 进行了一些通信shapes。他写道，要获得完整的普罗克拉斯特距离，您只需使用sin(riemdist)。因此前两只雌性大猩猩之间的完整普罗克拉斯特距离为：

sin(riemdist(gorf.dat[,,1],gorf.dat[,,2])) 
[1] 0.0643504

如果我们想创建自己的函数fpdist来做同样的事情：

fpdist<-function(x, y, reflect = FALSE){
sin(riemdist(x,y,reflect=reflect))
}

fpdist(gorf.dat[,,1],gorf.dat[,,2]) 
[1] 0.0643504

请注意，上面使用的大猩猩数据是 2D，但 3D 数据也可以正常工作：

library(shapes) # so we can use the built-in data
data(macm.dat) # Male macaque skull data. 7 landmarks in 3 dimensions, 9 individuals

# calculate procrustes distance for macaque individuals 1 and 2
# Claude's method 1
fPsup(macm.dat[,,1], macm.dat[,,2])$DF
[1] 0.1215633

# Claude's method 2
test<-fPsup(macm.dat[,,1], macm.dat[,,2])
sqrt(sum(ild2(test$Mp1, test$Mp2)^2))
[1] 0.1215633

# using the shapes package
fpdist(macm.dat[,,1], macm.dat[,,2])
[1] 0.1215633

这就是你所追求的吗？