R 在多条直线之间插值的最快方法

R 在多条直线之间插值的最快方法,r,interpolation,linear-interpolation,R,Interpolation,Linear Interpolation,我有14条不同直线的截距和斜率,其中y=Slope*x+截距。这些线大致平行,如下所示。每一行代表一个特定的类 Intercept Slope 1 8.787611 -3.435561 2 6.853230 -2.662021 3 6.660198 -2.584231 4 6.929856 -2.678694 5 6.637965 -2.572499 6 7.132044 -2.744441 7 7.233281 -2.802287 8 7.2851

我有14条不同直线的截距和斜率,其中
y=Slope*x+截距
。这些线大致平行,如下所示。每一行代表一个特定的类

   Intercept     Slope
1   8.787611 -3.435561
2   6.853230 -2.662021
3   6.660198 -2.584231
4   6.929856 -2.678694
5   6.637965 -2.572499
6   7.132044 -2.744441
7   7.233281 -2.802287
8   7.285169 -2.807539
9   7.207577 -2.772140
10  6.872071 -2.640098
11  6.778350 -2.612107
12  6.994820 -2.706729
13  6.947074 -2.690497
14  7.486870 -2.864093
当新数据以
(x,y)
的形式输入时。我想做两件事:

1) 找出最靠近该点的线(例如“1”、“4”或“8”)

2) 在x=2.6处找到插值。这意味着,如果一个点位于两条直线之间,且对于
x=2.6
,直线的值为
0
-0.05
,则插值将与点到直线的距离成比例

      x         y
1  2.545726 0.1512721
2  2.545726 0.1512721
3  2.545843 0.1512721
4  2.545994 0.1512721
5  2.546611 0.1512721
6  2.546769 0.1512721
7  2.546995 0.1416945
8  2.547269 0.1416945
9  2.548765 0.1416945
10 2.548996 0.1416945
我正在考虑编写自己的代码,并使用,然后选择点上方和下方的两条线的最小距离(如果该点不在所有14条线的上方或下方),从14条线中找到新点的距离,并按比例插值。然而,我很确定这不是最快的方法,因为它不是矢量化的。我想知道是否有更快的方法来完成这项任务。


直线我不确定你对“最近”的定义。你是指给定x的y的绝对差,还是指到直线上任何点的排序距离。对于第二部分,你不再使用最近的直线了吗?你需要两条最近的线(一条在上面,一条在下面)?这应该是你想要的输出吗?它们有不同的x值是有原因的吗?有一个清晰的例子可能会有帮助。@MrFlick从一点到一条线的距离,我指的是穿过该点并垂直于原始线的假想线的长度。所需的输出是距离该点最近的两条直线的结果的加权平均值。我不确定“最近”的定义。您是指给定x的y的绝对差,还是指到该直线上任何点的排序距离。对于第二部分,你不再使用最近的直线了吗?你需要两条最近的线(一条在上面,一条在下面)?这应该是你想要的输出吗?它们有不同的x值是有原因的吗?有一个清晰的例子可能会有帮助。@MrFlick从一点到一条线的距离,我指的是穿过该点并垂直于原始线的假想线的长度。期望的输出是距离点最近的两条线的结果的加权平均值。这正是我想要的。这种方法比FORTRAN或C++的插值模块快吗?比如<代码> Akimi?不,它不会比C++快。通过将sapply转换为mclappy,还可以对上述代码进行多线程处理。但我怀疑它将足够快的单线程。你的真实数据集有多大?这正是我想要的。这种方法比FORTRAN或C++的插值模块快吗?比如<代码> Akimi?不,它不会比C++快。通过将sapply转换为mclappy,还可以对上述代码进行多线程处理。但我怀疑它将足够快的单线程。您的真实数据集有多大?
lines <- read.table(textConnection("
   Intercept     Slope
1   8.787611 -3.435561
2   6.853230 -2.662021
3   6.660198 -2.584231
4   6.929856 -2.678694
5   6.637965 -2.572499
6   7.132044 -2.744441
7   7.233281 -2.802287
8   7.285169 -2.807539
9   7.207577 -2.772140
10  6.872071 -2.640098
11  6.778350 -2.612107
12  6.994820 -2.706729
13  6.947074 -2.690497
14  7.486870 -2.864093"))


points <- read.table(textConnection("
      x         y
1  2.545726 0.1512721
2  2.545726 0.1512721
3  2.545843 0.1512721
4  2.545994 0.1512721
5  2.546611 0.1512721
6  2.546769 0.1512721
7  2.546995 0.1416945
8  2.547269 0.1416945
9  2.548765 0.1416945
10 2.548996 0.1416945"))

cartDist <- function(lines, x, y) {
    with(lines, abs(Slope*x-y+Intercept)/sqrt(Slope^2+1))
}

interp_ys <- sapply(1:nrow(points), function(i) {
    x <- points$x[i]
    y <- points$y[i]
    dists <- cartDist(lines, x, y)
    dr <- rank(dists)
    wh <- which(dr %in% c(1,2))
    ys <- with(lines[wh,], Slope*2.6+Intercept)
    sum(((sum(dists[wh]) - dists[wh]) * ys))/sum(dists[wh]) #weighted average
})

plot(NA, ylim=c(-0.01,0.16), xlim=c(2.53,2.61), xlab="x", ylab="y", main="Interpolated points")
for(i in 1:nrow(lines)) {
    abline(b=lines$Slope[i], a=lines$Intercept[i], col="gray")
}
points(x=points$x, y=points$y, col="red")
points(x=rep(2.6, nrow(points)), y=interp_ys, col="blue")
segments(x0=rep(2.6, nrow(points)), y0=interp_ys, x1=points$x, y1=points$y, lty=2,col="black")