基于Procrustes分析的两种三维点云形状比较

Question

我有两个三维点云。我想比较一下它们的形状和程度。我认为Procrustes Analysis是一条可行的道路。我已经安装了软件包'shapes‘，它提供了几种类型的Procrustes分析，例如通用Procrustes分析(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

更新我和shapes包的作者Ian Dryden有过一些通信。他写道，要获得完整的Procrustes距离，你只需要使用sin(riemdist)。所以前两只雌性大猩猩之间的完整Procrustes距离是：

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

请注意，上面使用的gorilla数据是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

这就是你要找的吗？