如何在R中基于硬组织Procrustes拟合对齐完整3D地标数据？

核心思路是：对每个个体，先通过硬组织地标计算出对齐到硬组织共识所需的旋转、平移、缩放变换，再将该变换完整应用到包含软组织的全部地标矩阵，而非仅处理硬组织部分。

方法一：使用rotonto获取变换并应用到完整地标 #

1. 提取硬组织的共识形状：

hard_consensus <- hardproc$mshape

2. 创建空数组存储对齐后的完整地标数据：

aligned_full_array <- array(0, dim = dim(combinedarray))

3. 循环处理每个个体，将变换应用到完整地标：

for (i in 1:dim(combinedarray)[3]) {
  # 提取当前个体的完整地标矩阵
  full_landmarks <- combinedarray[,,i]
  # 提取当前个体的硬组织地标
  hard_landmarks <- full_landmarks[618:931,]
  
  # 计算硬组织对齐到共识的变换
  trans <- rotonto(target = hard_consensus, source = hard_landmarks)
  
  # 将变换应用到完整地标集
  aligned_full <- applyTransform(trans, full_landmarks)
  
  # 存入结果数组
  aligned_full_array[,,i] <- aligned_full
}

方法二：利用align2procSym的变换参数处理完整地标 #

align2procSym会返回对齐硬组织的变换参数（旋转、平移、缩放），可直接用这些参数变换完整地标：

aligned_full_array <- array(0, dim = dim(combinedarray))
hard_consensus <- hardproc$mshape

for (i in 1:dim(combinedarray)[3]) {
  full_landmarks <- combinedarray[,,i]
  hard_landmarks <- full_landmarks[618:931,]
  
  # 获取硬组织的对齐结果及变换参数
  align_result <- align2procSym(hardproc, hard_landmarks)
  
  # 提取变换参数
  rot_mat <- align_result$rotation
  trans_vec <- align_result$translation
  scale_factor <- align_result$scaling
  
  # 对完整地标应用缩放、旋转、平移变换
  full_centered <- scale(full_landmarks, center = TRUE, scale = FALSE)
  full_scaled <- full_centered * scale_factor
  full_rotated <- full_scaled %*% rot_mat
  full_aligned <- full_rotated + trans_vec + colMeans(hard_consensus)
  
  # 存入结果数组
  aligned_full_array[,,i] <- full_aligned
}

验证结果 #

对齐完成后，可检查硬组织部分是否与hardproc$orpdata匹配：

# 提取第一个个体对齐后的硬组织
aligned_hard <- aligned_full_array[618:931,,1]
# 对比硬组织Procrustes后的结果
all.equal(aligned_hard, hardproc$orpdata[,,1], tolerance = 1e-6)

内容的提问来源于stack exchange，提问作者Catherine Sulzmann