r - 玩完美俄罗斯方 block : how to align and scale two curves using scaling and translation?

Question

给定 y 轴 (s) 上的缩放和 x 轴 (t) 上的平移参数，当目的是最大化曲线叠加(而不是最小化距离)时，如何缩放和对齐两条不重合的曲线？

正如 @DWin 所指出的，这可能会被重新命名为“如何使用 R 完美地玩俄罗斯方 block ”，尽管它的应用范围远远超出了赢得俄罗斯方 block 游戏的范围。

这个问题的一个变体可能涉及任意数量的刚体变换(旋转、平移和缩放)。

给定曲线 1

curve1<-data.frame(x=c(1,1,2,2,3),
                   y=c(9,6,6,3,3))

with(curve1, plot(x=x, y=y, type="l", xlim=c(0,10), ylim=c(0,10)))

和曲线 2

curve2<-data.frame(x=c(4,5,5,6,6,7),
                   y=c(2,2,1,1,2,3))

with(curve2, plot(x=x, y=y, type="l", xlim=c(0,10), ylim=c(0,10)))

我希望找到使两条曲线之间叠加最大化的 s 和 t。

理想情况下，该方法应在 R 中使用 optim。

在这个虚构的示例中，t=3 且 s=1/3，因此

t=3
s=1/3

with(curve2, plot(x=x, y=y, type="l", xlim=c(0,10), ylim=c(0,10)))

with(curve1, lines(x=x+t, y=y*s, col="red"))

请注意，为了获得这样的拟合，可以达成共识的区域必须比无法叠加的区域具有更高的参数化权重，并且共识区域越大，权重越高。

我一直在探索的路线:

minimize area between curves

algorithm for superposing two curves

使用shapes包进行形状分析

Iterative closest point (ICP)如果有人已经在 R 中实现了它或者可以移植 C 实现之一

使用最大似然法的奖励积分(假设误差呈正态分布)。

Answer 1

当 curve1 在 y 轴上按因子“tfac”缩放并在 x 轴上移动量“s”时，这将返回点之间的距离:

 as.matrix( dist( rbind(as.matrix(curve2), 
                 ( matrix(c(rep(s, 5), rep(1,5)), ncol=2) +   # x-shift matrix
                                       as.matrix(curve1) ) %*% 
                   matrix(c( 1, 0, 0, tfac),ncol=2) ) ) # the y-scaling matrix
                )[ 
                           # better not to use 't' as a variable name
      -(1:5), -(6:11)]  # easier to return the relevant distances when in matrix

将其放入要最小化的函数中应该是一件简单的事情:

 dfunc <- function(C1, C2, s, tfac) { sum( .... ) }

我不确定这会返回您期望的结果，因为您暗示的目标函数可能不是距离之和。您可能需要转向整数编程方法。优化 CRAN 任务 View 将是在 R 中查找这些方法的好地方。我想如果出现此问题，另一种选择可能是将“s”值舍入并仅缩放到最接近的 2 次方。

dfunc <- function(param, D1=curve1, D2=curve2) { 
           sum( as.matrix(dist( 
                   rbind(as.matrix(D2), 
                         ( matrix(c(rep(param[1], 5), rep(1,5)), ncol=2) + 
                           as.matrix(D1) ) %*% 
                   matrix(c(1,0,0,param[2]),ncol=2) ) ) )[-(1:5), -(6:11)])}
optim(c(1,1), dfunc)
#$par
$[1] 3.3733977 0.2243866
# trimmed output

使用这些值可以获得以下叠加:

因此，我可能会尝试 s=3，tfac=0.25。 (回想起来，我发现我按照您的要求交换了 t 和 s 的角色。抱歉。)